home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / dde / _pascals / c / pascals < prev   
Encoding:
Text File  |  1992-03-31  |  75.4 KB  |  3,764 lines
  1. /* Output from p2c, the Pascal-to-C translator */
  2. /* From input file "temp.p" */
  3.  
  4.  
  5. #include "p2c.h"
  6.  
  7.  
  8. #define maxkeywords     27
  9. #define alphalength     10
  10. #define linelength      120
  11. #define emax            322
  12. #define emin            (-99)
  13. #define kmax            15
  14. #define tmax            100
  15. #define bmax            20
  16. #define amax            30
  17. #define c2max           20
  18. #define csmax           30
  19. #define cmax            850
  20. #define lmax            7
  21. #define smax            600
  22. #define ermax           58
  23. #define omax            63
  24.  
  25. #define xmax            131071L
  26. #define nmax            LONG_MAX
  27.  
  28. #define lineleng        136
  29. #define linelimit       200
  30. #define stacksize       1500
  31.  
  32.  
  33. typedef enum {
  34.   intcon, realcon, charcon, string, notsy, plus, minus, times, idiv, rdiv,
  35.   imod, andsy, orsy, eql, neq, gtr, geq, lss, leq, lparent, rparent, lbrack,
  36.   rbrack, comma, semicolon, period, colon, becomes, constsy, typesy, varsy,
  37.   functionsy, proceduresy, arraysy, recordsy, programsy, ident, beginsy, ifsy,
  38.   casesy, repeatsy, whilesy, forsy, endsy, elsesy, untilsy, ofsy, dosy, tosy,
  39.   downtosy, thensy
  40. } symbol;
  41. /* p2c: temp.p, line 36:
  42.  * Note: Line breaker spent 0.0 seconds, 5000 tries on line 39 [251] */
  43. typedef long index_;
  44.  
  45. typedef Char alfa_[alphalength];
  46. typedef enum {
  47.   konstant, variable, type1, prozedure, funktion
  48. } object;
  49. typedef enum {
  50.   notyp, ints, reals, bools, chars, arrays, records
  51. } types;
  52. typedef long symset[3];
  53.  
  54. typedef long typset;
  55.  
  56. typedef struct item {
  57.   types typ;
  58.   index_ iref;
  59. } item;
  60.  
  61. typedef struct order {
  62.   char f;
  63.   char x;
  64.   long y;
  65. } order;
  66.  
  67.  
  68. typedef struct _REC_tab {
  69.   alfa_ name;
  70.   index_ link;
  71.   unsigned obj : 3;
  72. /* p2c: temp.p, line 79:
  73.  * Note: Field width for OBJ assumes enum object has 5 elements [105] */
  74.   unsigned typ : 3;
  75. /* p2c: temp.p, line 80:
  76.  * Note: Field width for TYP assumes enum types has 7 elements [105] */
  77.   Signed int iref : 18;
  78.   unsigned normal : 1, lev : 3;
  79.   long adr;
  80. } _REC_tab;
  81.  
  82. typedef struct _REC_atab {
  83.   unsigned inxtyp : 3, eltyp : 3;
  84. /* p2c: temp.p, line 88:
  85.  * Note: Field width for INXTYP assumes enum types has 7 elements [105] */
  86.   Signed int eliref : 18, low : 18, high : 18, elsize : 18, size : 18;
  87. } _REC_atab;
  88.  
  89. typedef struct _REC_btab {
  90.   index_ last, lastpar, psize, vsize;
  91. } _REC_btab;
  92.  
  93.  
  94. Static symbol sy;
  95. Static alfa_ id;
  96. Static long inum;
  97. Static double rnum;
  98. Static long sleng;
  99. Static Char ch;
  100. Static Char line[linelength];
  101. Static long cc, lc, ll;
  102. Static long errs[ermax / 32 + 2];
  103. Static long errpos;
  104. Static alfa_ progname;
  105. Static boolean iflag, oflag;
  106. Static symset constbegsys, typebegsys, blockbegsys, facbegsys, statbegsys;
  107. Static alfa_ key[maxkeywords];
  108. Static symbol ksy[maxkeywords];
  109. Static symbol sps[256];
  110. Static long t, a, b, sx, c1, c2;
  111. Static typset stantyps;
  112. Static long display[lmax + 1];
  113. Static _REC_tab tab[tmax + 1];
  114. Static _REC_atab atab[amax];
  115. Static _REC_btab btab[bmax];
  116. Static Char stab[smax + 1];
  117. Static double rconst[c2max];
  118. Static order code[cmax + 1];
  119.  
  120.  
  121. Static Void errormsg()
  122. {
  123.   long k;
  124.   alfa_ msg[ermax + 1];
  125.   long SET[257];
  126.  
  127.   /*errormsg*/
  128.   memcpy(msg[0], "undef id  ", sizeof(alfa_));
  129.   memcpy(msg[1], "multi def ", sizeof(alfa_));
  130.   memcpy(msg[2], "identifier", sizeof(alfa_));
  131.   memcpy(msg[3], "program   ", sizeof(alfa_));
  132.   memcpy(msg[4], ")         ", sizeof(alfa_));
  133.   memcpy(msg[5], ":         ", sizeof(alfa_));
  134.   memcpy(msg[6], "syntax    ", sizeof(alfa_));
  135.   memcpy(msg[7], "ident, var", sizeof(alfa_));
  136.   memcpy(msg[8], "of        ", sizeof(alfa_));
  137.   memcpy(msg[9], "(         ", sizeof(alfa_));
  138.   memcpy(msg[10], "id, array ", sizeof(alfa_));
  139.   memcpy(msg[11], "[         ", sizeof(alfa_));
  140.   memcpy(msg[12], "]         ", sizeof(alfa_));
  141.   memcpy(msg[13], "..        ", sizeof(alfa_));
  142.   memcpy(msg[14], ";         ", sizeof(alfa_));
  143.   memcpy(msg[15], "func. type", sizeof(alfa_));
  144.   memcpy(msg[16], "=         ", sizeof(alfa_));
  145.   memcpy(msg[17], "boolean   ", sizeof(alfa_));
  146.   memcpy(msg[18], "convar typ", sizeof(alfa_));
  147.   memcpy(msg[19], "type      ", sizeof(alfa_));
  148.   memcpy(msg[20], "prog.param", sizeof(alfa_));
  149.   memcpy(msg[21], "too big   ", sizeof(alfa_));
  150.   memcpy(msg[22], ".         ", sizeof(alfa_));
  151.   memcpy(msg[23], "typ (case)", sizeof(alfa_));
  152.   memcpy(msg[24], "character ", sizeof(alfa_));
  153.   memcpy(msg[25], "const id  ", sizeof(alfa_));
  154.   memcpy(msg[26], "index type", sizeof(alfa_));
  155.   memcpy(msg[27], "indexbound", sizeof(alfa_));
  156.   memcpy(msg[28], "no array  ", sizeof(alfa_));
  157.   memcpy(msg[29], "type id   ", sizeof(alfa_));
  158.   memcpy(msg[30], "undef type", sizeof(alfa_));
  159.   memcpy(msg[31], "no record ", sizeof(alfa_));
  160.   memcpy(msg[32], "boole type", sizeof(alfa_));
  161.   memcpy(msg[33], "arith type", sizeof(alfa_));
  162.   memcpy(msg[34], "integer   ", sizeof(alfa_));
  163.   memcpy(msg[35], "types     ", sizeof(alfa_));
  164.   memcpy(msg[36], "param type", sizeof(alfa_));
  165.   memcpy(msg[37], "variab typ", sizeof(alfa_));
  166.   memcpy(msg[38], "string    ", sizeof(alfa_));
  167.   memcpy(msg[39], "no.of pars", sizeof(alfa_));
  168.   memcpy(msg[40], "type      ", sizeof(alfa_));
  169.   memcpy(msg[41], "type      ", sizeof(alfa_));
  170.   memcpy(msg[42], "real type ", sizeof(alfa_));
  171.   memcpy(msg[43], "integer   ", sizeof(alfa_));
  172.   memcpy(msg[44], "var, const", sizeof(alfa_));
  173.   memcpy(msg[45], "var, proc ", sizeof(alfa_));
  174.   memcpy(msg[46], "types (:=)", sizeof(alfa_));
  175.   memcpy(msg[47], "typ (case)", sizeof(alfa_));
  176.   memcpy(msg[48], "type      ", sizeof(alfa_));
  177.   memcpy(msg[49], "store ovfl", sizeof(alfa_));
  178.   memcpy(msg[50], "constant  ", sizeof(alfa_));
  179.   memcpy(msg[51], ":=        ", sizeof(alfa_));
  180.   memcpy(msg[52], "then      ", sizeof(alfa_));
  181.   memcpy(msg[53], "until     ", sizeof(alfa_));
  182.   memcpy(msg[54], "do        ", sizeof(alfa_));
  183.   memcpy(msg[55], "to downto ", sizeof(alfa_));
  184.   memcpy(msg[56], "begin     ", sizeof(alfa_));
  185.   memcpy(msg[57], "end       ", sizeof(alfa_));
  186.   memcpy(msg[58], "factor    ", sizeof(alfa_));
  187.   k = 0;
  188.   printf("\n key words\n");
  189.   while (*errs != 0L) {
  190.     while (!P_inset((int)k, errs))
  191.       k++;
  192.     printf("%12ld  %.*s\n", k, alphalength, msg[k]);
  193.     P_remset(errs, (int)k);
  194.   }  /*while*/
  195. }
  196.  
  197.  
  198. Static jmp_buf _JL99;
  199.  
  200.  
  201. Static Void nextch()
  202. {
  203.   /* read the next character and the end of lines */
  204.   /*nextch*/
  205.   if (cc == ll) {   /*if*/
  206.     if (P_eof(stdin)) {   /*if*/
  207.       printf("\n program incomplete.\n");
  208.       errormsg();
  209.       longjmp(_JL99, 1);
  210.     }
  211.     if (errpos != 0) {   /*if*/
  212.       putchar('\n');
  213.       errpos = 0;
  214.     }
  215.     printf("%5ld  ", lc);
  216.     ll = 0;
  217.     cc = 0;
  218.     while (!P_eoln(stdin)) {   /*while*/
  219.       ll++;
  220.       ch = getchar();
  221.       if (ch == '\n')
  222.     ch = ' ';
  223.       putchar(ch);
  224.       line[ll - 1] = ch;
  225.     }
  226.     putchar('\n');
  227.     ll++;
  228.     line[ll - 1] = getchar();
  229.     if (line[ll - 1] == '\n')
  230.       line[ll - 1] = ' ';
  231.   }
  232.   cc++;
  233.   ch = line[cc - 1];
  234. }
  235.  
  236.  
  237. Static Void error(n)
  238. long n;
  239. {
  240.   long SET[3];
  241.  
  242.   /*error*/
  243.   if (errpos == 0)
  244.     printf(" ****");
  245.   if (cc <= errpos) {
  246.     return;
  247.   }  /*if*/
  248.   printf("%*c@%2ld", (int)(cc - errpos), ' ', n);
  249.   errpos = cc + 3;
  250.   P_addset(errs, (int)n);
  251. }
  252.  
  253.  
  254. Static Void fatal(n)
  255. long n;
  256. {
  257.   alfa_ msg[7];
  258.  
  259.   /*fatal*/
  260.   putchar('\n');
  261.   errormsg();
  262.   memcpy(msg[0], "identifier", sizeof(alfa_));
  263.   memcpy(msg[1], "procedures", sizeof(alfa_));
  264.   memcpy(msg[2], "reals     ", sizeof(alfa_));
  265.   memcpy(msg[3], "arrays    ", sizeof(alfa_));
  266.   memcpy(msg[4], "levels    ", sizeof(alfa_));
  267.   memcpy(msg[5], "code      ", sizeof(alfa_));
  268.   memcpy(msg[6], "strings   ", sizeof(alfa_));
  269.   printf(" compiler table for %.*s is too small\n", alphalength, msg[n - 1]);
  270.   longjmp(_JL99, 1);   /* terminate compilation */
  271. }
  272.  
  273.  
  274. /* Local variables for insymbol: */
  275. struct LOC_insymbol {
  276.   long k, e;
  277. } ;
  278.  
  279.  
  280. Local Void readscale(LINK)
  281. struct LOC_insymbol *LINK;
  282. {
  283.   long s, sign;
  284.  
  285.   /*readscale*/
  286.   nextch();
  287.   sign = 1;
  288.   s = 0;
  289.   if (ch == '+')
  290.     nextch();
  291.   else {
  292.     if (ch == '-') {   /*if*/
  293.       nextch();
  294.       sign = -1;
  295.     }
  296.   }
  297.   while (isdigit(ch)) {   /*while*/
  298.     s = s * 10 + ch - '0';
  299.     nextch();
  300.   }
  301.   LINK->e += s * sign;
  302. }
  303.  
  304.  
  305. Local Void adjustscale(LINK)
  306. struct LOC_insymbol *LINK;
  307. {
  308.   long s;
  309.   double d, t;
  310.  
  311.   /*adjustscale*/
  312.   if (LINK->k + LINK->e > emax) {
  313.     error(21L);
  314.     return;
  315.   }
  316.   if (LINK->k + LINK->e < emin) {
  317.     rnum = 0.0;
  318.     return;
  319.   }
  320.   s = labs(LINK->e);
  321.   t = 1.0;
  322.   d = 10.0;
  323.   do {
  324.     while (!(s & 1)) {   /*while*/
  325.       s /= 2;
  326.       d *= d;
  327.     }
  328.     s--;
  329.     t = d * t;
  330.   } while (s != 0);
  331.   if (LINK->e >= 0)
  332.     rnum *= t;
  333.   else
  334.     rnum /= t;
  335.  
  336.   /*else*/
  337. }
  338.  
  339.  
  340. Static Void insymbol()
  341. {
  342.   /* reads next symbol */
  343.   struct LOC_insymbol V;
  344.  
  345.   long i, j;
  346.  
  347.  
  348.   /*insymbol*/
  349. _L1:
  350.   while (ch == ' ')
  351.     nextch();
  352.   if (islower(ch)) {  /*word*/
  353.     V.k = 0;
  354.     memcpy(id, "          ", sizeof(alfa_));
  355.     do {
  356.       if (V.k < alphalength) {   /*if*/
  357.     V.k++;
  358.     id[V.k - 1] = ch;
  359.       }
  360.       nextch();
  361.     } while (islower(ch) || isdigit(ch));
  362.     i = 1;
  363.     j = maxkeywords;
  364.     /* binary search */
  365.     do {
  366.       V.k = (i + j) / 2;
  367.       if (strncmp(id, key[V.k - 1], sizeof(alfa_)) <= 0)
  368.     j = V.k - 1;
  369.       if (strncmp(id, key[V.k - 1], sizeof(alfa_)) >= 0)
  370.     i = V.k + 1;
  371.     } while (i <= j);
  372.     if (i - 1 > j)
  373.       sy = ksy[V.k - 1];
  374.     else
  375.       sy = ident;
  376.     return;
  377.   }  /*if*/
  378.   if (isdigit(ch)) {  /* number */
  379.     V.k = 0;
  380.     inum = 0;
  381.     sy = intcon;
  382.     do {
  383.       inum = inum * 10 + ch - '0';
  384.       V.k++;
  385.       nextch();
  386.     } while (isdigit(ch));
  387.     if (V.k > kmax || inum > nmax) {   /*if*/
  388.       error(21L);
  389.       inum = 0;
  390.       V.k = 0;
  391.     }
  392.     if (ch == '.') {
  393.       nextch();
  394.       if (ch == '.') {
  395.     ch = ':';
  396.     return;
  397.       }
  398.       sy = realcon;
  399.       rnum = inum;
  400.       V.e = 0;
  401.       while (isdigit(ch)) {   /*while*/
  402.     V.e--;
  403.     rnum = 10.0 * rnum + ch - '0';
  404.     nextch();
  405.       }
  406.       if (ch == 'e')
  407.     readscale(&V);
  408.       if (V.e != 0)
  409.     adjustscale(&V);
  410.       return;
  411.     }  /*if*/
  412.     if (ch != 'e') {
  413.       return;
  414.     }  /*if*/
  415.     sy = realcon;
  416.     rnum = inum;
  417.     V.e = 0;
  418.     readscale(&V);
  419.     if (V.e != 0)
  420.       adjustscale(&V);
  421.     return;
  422.   }  /*if*/
  423.   switch (ch) {
  424.  
  425.   case ':':   /*':'*/
  426.     nextch();
  427.     if (ch == '=') {
  428.       sy = becomes;
  429.       nextch();
  430.     }  /*if*/
  431.     else
  432.       sy = colon;
  433.     break;
  434.  
  435.   case '<':   /*'<'*/
  436.     nextch();
  437.     if (ch == '=') {
  438.       sy = leq;
  439.       nextch();
  440.     }  /*if*/
  441.     else {
  442.       if (ch == '>') {
  443.     sy = neq;
  444.     nextch();
  445.       }  /*if*/
  446.       else
  447.     sy = lss;
  448.     }
  449.     break;
  450.  
  451.   case '>':   /*'>'*/
  452.     nextch();
  453.     if (ch == '=') {
  454.       sy = geq;
  455.       nextch();
  456.     }  /*if*/
  457.     else
  458.       sy = gtr;
  459.     break;
  460.  
  461.   case '.':   /*'.'*/
  462.     nextch();
  463.     if (ch == '.') {
  464.       sy = colon;
  465.       nextch();
  466.     }  /*if*/
  467.     else
  468.       sy = period;
  469.     break;
  470.  
  471.   case '\'':   /*''''*/
  472.     V.k = 0;
  473. _L2:
  474.     nextch();
  475.     if (ch == '\'') {   /*if*/
  476.       nextch();
  477.       if (ch != '\'')
  478.     goto _L3;
  479.     }
  480.     if (sx + V.k == smax)
  481.       fatal(7L);
  482.     stab[sx + V.k] = ch;
  483.     V.k++;
  484.     if (cc != 1) {  /* end of line */
  485.       goto _L2;
  486.     }  /*if*/
  487.     V.k = 0;
  488. _L3:
  489.     if (V.k == 1) {
  490.       sy = charcon;
  491.       inum = stab[sx];
  492.     }  /*if*/
  493.     else {
  494.       if (V.k == 0) {
  495.     error(38L);
  496.     sy = charcon;
  497.     inum = 0;
  498.       }  /*if*/
  499.       else {
  500.     sy = string;
  501.     inum = sx;
  502.     sleng = V.k;
  503.     sx += V.k;
  504.       }  /*else*/
  505.     }
  506.     break;
  507.  
  508.   case '(':   /*'('*/
  509.     nextch();
  510.     if (ch == '*') {
  511.       do {
  512.     while (ch != '*')
  513.       nextch();
  514.     nextch();
  515.       } while (ch != ')');
  516.       nextch();
  517.       goto _L1;
  518.     }
  519.     sy = lparent;
  520.     break;
  521.  
  522.   case '+':
  523.   case '-':
  524.   case '*':
  525.   case '/':
  526.   case ')':
  527.   case '=':
  528.   case ',':
  529.   case '[':
  530.   case ']':
  531.   case '#':
  532.   case '&':
  533.   case ';':   /*'+'*/
  534.     sy = sps[ch];
  535.     nextch();
  536.     break;
  537.  
  538.   case '\\':
  539.   case '%':
  540.   case '@':
  541.   case '$':
  542.   case '!':
  543.     error(24L);
  544.     nextch();
  545.     goto _L1;
  546.     break;
  547.     /*'\'*/
  548.   }/*case*/
  549.  
  550.   /*else*/
  551.   /* comment */
  552.   /*else*/
  553. }
  554.  
  555.  
  556. Static Void enter(x0, x1, x2, x3)
  557. Char *x0;
  558. object x1;
  559. types x2;
  560. long x3;
  561. {  /* enter standard identifier */
  562.   _REC_tab *WITH;
  563.  
  564.   /*enter*/
  565.   t++;
  566.   WITH = &tab[t];
  567.   memcpy(WITH->name, x0, sizeof(alfa_));
  568.   WITH->link = t - 1;
  569.   WITH->obj = (unsigned)x1;
  570.   WITH->typ = (unsigned)x2;
  571.   WITH->iref = 0;
  572.   WITH->normal = true;
  573.   WITH->lev = 0;
  574.   WITH->adr = x3;   /*with*/
  575. }
  576.  
  577.  
  578. Static Void enterarray(tp, l, h)
  579. types tp;
  580. long l, h;
  581. {
  582.   _REC_atab *WITH;
  583.  
  584.   /*enterarray*/
  585.   if (l > h)
  586.     error(27L);
  587.   if (labs(l) > xmax || labs(h) > xmax) {   /*if*/
  588.     error(27L);
  589.     l = 0;
  590.     h = 0;
  591.   }
  592.   if (a == amax) {
  593.     fatal(4L);
  594.     return;
  595.   }
  596.   a++;
  597.   WITH = &atab[a - 1];
  598.   WITH->inxtyp = (unsigned)tp;
  599.   WITH->low = l;
  600.   WITH->high = h;   /*with*/
  601.  
  602.   /*else*/
  603. }
  604.  
  605.  
  606. Static Void enterblock()
  607. {
  608.   /*enterblock*/
  609.   if (b == bmax) {
  610.     fatal(2L);
  611.     return;
  612.   }
  613.   b++;
  614.   btab[b - 1].last = 0;
  615.   btab[b - 1].lastpar = 0;
  616.  
  617.   /*else*/
  618. }
  619.  
  620.  
  621. Static Void enterreal(x)
  622. double x;
  623. {
  624.   /*enterreal*/
  625.   if (c2 == c2max - 1) {
  626.     fatal(3L);
  627.     return;
  628.   }
  629.   rconst[c2] = x;
  630.   c1 = 1;
  631.   while (rconst[c1 - 1] != x)
  632.     c1++;
  633.   if (c1 > c2)
  634.     c2 = c1;
  635.  
  636.   /*else*/
  637. }
  638.  
  639.  
  640. Static Void emit(fct)
  641. long fct;
  642. {
  643.   /*emit*/
  644.   if (lc == cmax)
  645.     fatal(6L);
  646.   code[lc].f = fct;
  647.   lc++;
  648. }
  649.  
  650.  
  651. Static Void emit1(fct, b)
  652. long fct, b;
  653. {
  654.   order *WITH;
  655.  
  656.   /*emit1*/
  657.   if (lc == cmax)
  658.     fatal(6L);
  659.   WITH = &code[lc];
  660.   WITH->f = fct;
  661.   WITH->y = b;   /*with*/
  662.   lc++;
  663. }
  664.  
  665.  
  666. Static Void emit2(fct, a, b)
  667. long fct, a, b;
  668. {
  669.   order *WITH;
  670.  
  671.   /*emit2*/
  672.   if (lc == cmax)
  673.     fatal(6L);
  674.   WITH = &code[lc];
  675.   WITH->f = fct;
  676.   WITH->x = a;
  677.   WITH->y = b;   /*with*/
  678.   lc++;
  679. }
  680.  
  681.  
  682. Static Void printtables()
  683. {
  684.   long i;
  685.   order o;
  686.   long FORLIM;
  687.   _REC_tab *WITH;
  688.   _REC_btab *WITH1;
  689.   _REC_atab *WITH2;
  690.  
  691.   /*printtables*/
  692.   printf("0identifiers      link  obj  typ  iref  nrm  lev  adr\n");
  693.   FORLIM = t;
  694.   for (i = btab[0].last + 1; i <= FORLIM; i++) {
  695.     WITH = &tab[i];
  696.     printf("%12ld %.*s%5ld%5d%5d%5ld%5d%5d%5ld\n",
  697.        i, alphalength, WITH->name, WITH->link, (int)((object)WITH->obj),
  698.        (int)((types)WITH->typ), (long)SEXT(WITH->iref, 18), WITH->normal,
  699.        WITH->lev, WITH->adr);
  700.   }
  701.   printf("0blocks    last lpar psze vsze\n");
  702.   FORLIM = b;
  703.   for (i = 1; i <= FORLIM; i++) {
  704.     WITH1 = &btab[i - 1];
  705.     printf("%12ld%5ld%5ld%5ld%5ld\n",
  706.        i, WITH1->last, WITH1->lastpar, WITH1->psize, WITH1->vsize);
  707.   }
  708.   printf("0arrays    xtyp etyp eiref  low high elsz size\n");
  709.   FORLIM = a;
  710.   for (i = 1; i <= FORLIM; i++) {
  711.     WITH2 = &atab[i - 1];
  712.     printf("%12ld%5d%5d%5ld%5ld%5ld%5ld%5ld\n",
  713.        i, (int)((types)WITH2->inxtyp), (int)((types)WITH2->eltyp),
  714.        (long)SEXT(WITH2->eliref, 18), (long)SEXT(WITH2->low, 18),
  715.        (long)SEXT(WITH2->high, 18), (long)SEXT(WITH2->elsize, 18),
  716.        (long)SEXT(WITH2->size, 18));
  717.   }
  718.   printf("0code\n");
  719.   FORLIM = lc;
  720.   for (i = 0; i < FORLIM; i++) {   /*for*/
  721.     if (i % 5 == 0)   /*if*/
  722.       printf("\n%5ld", i);
  723. /* p2c: temp.p, line 689:
  724.  * Note: Using % for possibly-negative arguments [317] */
  725.     o = code[i];
  726.     printf("%5d", o.f);
  727.     if (o.f < 31) {
  728.       if (o.f < 4)
  729.     printf("%2d%5ld", o.x, o.y);
  730.       else
  731.     printf("%7ld", o.y);
  732.     } else
  733.       printf("        ");
  734.     putchar(',');
  735.   }
  736.   putchar('\n');
  737. }
  738.  
  739.  
  740. typedef struct conrec {
  741.   types tp;
  742.   union {
  743.     long i;
  744.     double r;
  745.   } UU;
  746. } conrec;
  747.  
  748.  
  749. Static Void block PP((long *fsys, int isfun, long level));
  750.  
  751. typedef struct _REC_casetab {
  752.   index_ val, lc;
  753. } _REC_casetab;
  754.  
  755. /* Local variables for block: */
  756. struct LOC_block {
  757.   symset fsys;
  758.   long level, dx;   /* data allocation index */
  759. } ;
  760.  
  761. Local Void typ PP((long *fsys, types *tp, long *rf, long *sz,
  762.            struct LOC_block *LINK));
  763. Local Void statement PP((long *fsys, struct LOC_block *LINK));
  764.  
  765.  
  766. Local Void skip(fsys, n, LINK)
  767. long *fsys;
  768. long n;
  769. struct LOC_block *LINK;
  770. {
  771.   /*skip*/
  772.   error(n);
  773.   while (!P_inset(sy, fsys))
  774.     insymbol();
  775. }
  776.  
  777.  
  778. Local Void test(s1, s2, n, LINK)
  779. long *s1, *s2;
  780. long n;
  781. struct LOC_block *LINK;
  782. {
  783.   symset SET;
  784.  
  785.   /*test*/
  786.   if (!P_inset(sy, s1))
  787.     skip(P_setunion(SET, s1, s2), n, LINK);
  788. }
  789.  
  790.  
  791. Local Void testsemicolon(LINK)
  792. struct LOC_block *LINK;
  793. {
  794.   long SET[(long)ident / 32 + 2];
  795.   symset SET1;
  796.  
  797.   /*testsemicolon*/
  798.   if (sy == semicolon)
  799.     insymbol();
  800.   else {   /*else*/
  801.     error(14L);
  802.     if ((unsigned long)sy < 32 &&
  803.     ((1L << ((long)sy)) & ((1L << ((long)comma)) | (1L << ((long)colon)))) != 0)
  804.       insymbol();
  805.   }
  806.   test(P_setunion(SET1, P_addset(P_expset(SET, 0L), (int)ident), blockbegsys),
  807.        LINK->fsys, 6L, LINK);
  808. }
  809.  
  810.  
  811. Local Void enter_(id, k, LINK)
  812. Char *id;
  813. object k;
  814. struct LOC_block *LINK;
  815. {
  816.   long j, l;
  817.   _REC_tab *WITH;
  818.  
  819.   /*enter*/
  820.   if (t == tmax) {
  821.     fatal(1L);
  822.     return;
  823.   }
  824.   memcpy(tab[0].name, id, sizeof(alfa_));
  825.   j = btab[display[LINK->level] - 1].last;
  826.   l = j;
  827.   while (strncmp(tab[j].name, id, sizeof(alfa_)))
  828.     j = tab[j].link;
  829.   if (j != 0) {
  830.     error(1L);
  831.     return;
  832.   }
  833.   t++;
  834.   WITH = &tab[t];
  835.   memcpy(WITH->name, id, sizeof(alfa_));
  836.   WITH->link = l;
  837.   WITH->obj = (unsigned)k;
  838.   WITH->typ = (unsigned)notyp;
  839.   WITH->iref = 0;
  840.   WITH->lev = LINK->level;
  841.   WITH->adr = 0;   /*with*/
  842.   btab[display[LINK->level] - 1].last = t;
  843.  
  844.   /*else*/
  845.   /*else*/
  846. }
  847.  
  848.  
  849. Local long loc(id, LINK)
  850. Char *id;
  851. struct LOC_block *LINK;
  852. {
  853.   long i, j;
  854.  
  855.   /* locate id in table */
  856.  
  857.   /*loc*/
  858.   i = LINK->level;
  859.   memcpy(tab[0].name, id, sizeof(alfa_));
  860.   do {
  861.     j = btab[display[i] - 1].last;
  862.     while (strncmp(tab[j].name, id, sizeof(alfa_)))
  863.       j = tab[j].link;
  864.     i--;
  865.   } while (i >= 0 && j == 0);
  866.   if (j == 0)
  867.     error(0L);
  868.   return j;
  869. }
  870.  
  871.  
  872. Local Void entervariable(LINK)
  873. struct LOC_block *LINK;
  874. {
  875.   /*entervariable*/
  876.   if (sy == ident) {
  877.     enter_(id, variable, LINK);
  878.     insymbol();
  879.   }  /*if*/
  880.   else
  881.     error(2L);
  882. }
  883.  
  884.  
  885. Local Void constant(fsys, c, LINK)
  886. long *fsys;
  887. conrec *c;
  888. struct LOC_block *LINK;
  889. {
  890.   long x, sign;
  891.   symset SET;
  892.  
  893.   /*constant*/
  894.   c->tp = notyp;
  895.   c->UU.i = 0;
  896.   test(constbegsys, fsys, 50L, LINK);
  897.   if (!P_inset(sy, constbegsys)) {
  898.     return;
  899.   }  /*if*/
  900.   if (sy == charcon) {
  901.     c->tp = chars;
  902.     c->UU.i = inum;
  903.     insymbol();
  904.   }  /*if*/
  905.   else {   /*else*/
  906.     sign = 1;
  907.     if ((unsigned long)sy < 32 &&
  908.     ((1L << ((long)sy)) & ((1L << ((long)plus)) | (1L << ((long)minus)))) != 0)
  909.     {   /*if*/
  910.       if (sy == minus)
  911.     sign = -1;
  912.       insymbol();
  913.     }
  914.     if (sy == ident) {
  915.       x = loc(id, LINK);
  916.       if (x != 0) {
  917.     if ((object)tab[x].obj != konstant)
  918.       error(25L);
  919.     else {   /*else*/
  920.       c->tp = (types)tab[x].typ;
  921.       if (c->tp == reals)
  922.         c->UU.r = sign * rconst[tab[x].adr - 1];
  923.       else
  924.         c->UU.i = sign * tab[x].adr;
  925.     }
  926.       }
  927.       insymbol();
  928.     }  /*if*/
  929.     else {
  930.       if (sy == intcon) {
  931.     c->tp = ints;
  932.     c->UU.i = sign * inum;
  933.     insymbol();
  934.       }  /*if*/
  935.       else {
  936.     if (sy == realcon) {
  937.       c->tp = reals;
  938.       c->UU.r = sign * rnum;
  939.       insymbol();
  940.     }  /*if*/
  941.     else
  942.       skip(fsys, 50L, LINK);
  943.       }
  944.     }
  945.   }
  946.   test(fsys, P_expset(SET, 0L), 6L, LINK);
  947. }
  948.  
  949. /* Local variables for typ: */
  950. struct LOC_typ {
  951.   struct LOC_block *LINK;
  952.   symset fsys;
  953. } ;
  954.  
  955.  
  956. Local Void arraytyp(airef, arsz, LINK)
  957. long *airef, *arsz;
  958. struct LOC_typ *LINK;
  959. {
  960.   types eltp;
  961.   conrec low, high;
  962.   long elrf, elsz;
  963.   long SET[(long)ofsy / 32 + 2];
  964.   symset SET1;
  965.   _REC_atab *WITH;
  966.  
  967.   /*arraytyp*/
  968.   P_addset(P_expset(SET, 0L), (int)colon);
  969.   P_addset(SET, (int)rbrack);
  970.   P_addset(SET, (int)rparent);
  971.   constant(P_setunion(SET1, P_addset(SET, (int)ofsy), LINK->fsys), &low,
  972.        LINK->LINK);
  973.   if (low.tp == reals) {   /*if*/
  974.     error(27L);
  975.     low.tp = ints;
  976.     low.UU.i = 0;
  977.   }
  978.   if (sy == colon)
  979.     insymbol();
  980.   else
  981.     error(13L);
  982.   P_addset(P_expset(SET, 0L), (int)rbrack);
  983.   P_addset(SET, (int)comma);
  984.   P_addset(SET, (int)rparent);
  985.   constant(P_setunion(SET1, P_addset(SET, (int)ofsy), LINK->fsys), &high,
  986.        LINK->LINK);
  987.   if (high.tp != low.tp) {   /*if*/
  988.     error(27L);
  989.     high.UU.i = low.UU.i;
  990.   }
  991.   enterarray(low.tp, low.UU.i, high.UU.i);
  992.   *airef = a;
  993.   if (sy == comma) {
  994.     insymbol();
  995.     eltp = arrays;
  996.     arraytyp(&elrf, &elsz, LINK);
  997.   }  /*if*/
  998.   else {   /*else*/
  999.     if (sy == rbrack)
  1000.       insymbol();
  1001.     else {   /*else*/
  1002.       error(12L);
  1003.       if (sy == rparent)
  1004.     insymbol();
  1005.     }
  1006.     if (sy == ofsy)
  1007.       insymbol();
  1008.     else
  1009.       error(8L);
  1010.     typ(LINK->fsys, &eltp, &elrf, &elsz, LINK->LINK);
  1011.   }
  1012.   WITH = &atab[*airef - 1];
  1013.   *arsz = (SEXT(WITH->high, 18) - SEXT(WITH->low, 18) + 1) * elsz;
  1014.   WITH->size = *arsz;
  1015.   WITH->eltyp = (unsigned)eltp;
  1016.   WITH->eliref = elrf;
  1017.   WITH->elsize = elsz;   /*with*/
  1018. }
  1019.  
  1020.  
  1021. Local Void typ(fsys_, tp, rf, sz, LINK)
  1022. long *fsys_;
  1023. types *tp;
  1024. long *rf, *sz;
  1025. struct LOC_block *LINK;
  1026. {
  1027.   struct LOC_typ V;
  1028.   long x;
  1029.   types eltp;
  1030.   long elrf, elsz, offset, t0, t1;
  1031.   _REC_tab *WITH;
  1032.   long SET[(long)endsy / 32 + 2];
  1033.   symset SET1;
  1034.  
  1035.  
  1036.   V.LINK = LINK;
  1037.   /*typ*/
  1038.   P_setcpy(V.fsys, fsys_);
  1039.   *tp = notyp;
  1040.   *rf = 0;
  1041.   *sz = 0;
  1042.   test(typebegsys, V.fsys, 10L, LINK);
  1043.   if (!P_inset(sy, typebegsys)) {
  1044.     return;
  1045.   }  /*if*/
  1046.   if (sy == ident) {
  1047.     x = loc(id, LINK);
  1048.     if (x != 0) {
  1049.       WITH = &tab[x];
  1050.       if ((object)WITH->obj != type1)
  1051.     error(29L);
  1052.       else {   /*else*/
  1053.     *tp = (types)WITH->typ;
  1054.     *rf = SEXT(WITH->iref, 18);
  1055.     *sz = WITH->adr;
  1056.     if (*tp == notyp)
  1057.       error(30L);
  1058.       }
  1059.     }
  1060.     insymbol();
  1061.   }  /*if*/
  1062.   else {
  1063.     if (sy == arraysy) {
  1064.       insymbol();
  1065.       if (sy == lbrack)
  1066.     insymbol();
  1067.       else {   /*else*/
  1068.     error(11L);
  1069.     if (sy == lparent)
  1070.       insymbol();
  1071.       }
  1072.       *tp = arrays;
  1073.       arraytyp(rf, sz, &V);
  1074.     }  /*if*/
  1075.     else   /*else*/
  1076.     {  /*records*/
  1077.       insymbol();
  1078.       enterblock();
  1079.       *tp = records;
  1080.       *rf = b;
  1081.       if (LINK->level == lmax)
  1082.     fatal(5L);
  1083.       LINK->level++;
  1084.       display[LINK->level] = b;
  1085.       offset = 0;
  1086.       while (sy != endsy)   /*while*/
  1087.       {  /* field secxtion */
  1088.     if (sy == ident) {   /*if*/
  1089.       t0 = t;
  1090.       entervariable(LINK);
  1091.       while (sy == comma) {   /*while*/
  1092.         insymbol();
  1093.         entervariable(LINK);
  1094.       }
  1095.       if (sy == colon)
  1096.         insymbol();
  1097.       else
  1098.         error(5L);
  1099.       t1 = t;
  1100.       P_addset(P_expset(SET, 0L), (int)semicolon);
  1101.       P_addset(SET, (int)endsy);
  1102.       P_addset(SET, (int)comma);
  1103.       typ(P_setunion(SET1, V.fsys, P_addset(SET, (int)ident)), &eltp,
  1104.           &elrf, &elsz, LINK);
  1105.       while (t0 < t1) {
  1106.         t0++;
  1107.         WITH = &tab[t0];
  1108.         WITH->typ = (unsigned)eltp;
  1109.         WITH->iref = elrf;
  1110.         WITH->normal = true;
  1111.         WITH->adr = offset;
  1112.         offset += elsz;   /*with*/
  1113.       }  /*while*/
  1114.     }
  1115.     if (sy == endsy)   /*if*/
  1116.       break;
  1117.     if (sy == semicolon)
  1118.       insymbol();
  1119.     else {   /*else*/
  1120.       error(14L);
  1121.       if (sy == comma)
  1122.         insymbol();
  1123.     }
  1124.     P_addset(P_expset(SET, 0L), (int)ident);
  1125.     P_addset(SET, (int)endsy);
  1126.     test(P_addset(SET, (int)semicolon), V.fsys, 6L, LINK);
  1127.       }
  1128.       btab[*rf - 1].vsize = offset;
  1129.       *sz = offset;
  1130.       btab[*rf - 1].psize = 0;
  1131.       insymbol();
  1132.       LINK->level--;
  1133.     }
  1134.   }
  1135.   test(V.fsys, P_expset(SET1, 0L), 6L, LINK);
  1136. }
  1137.  
  1138.  
  1139. Local Void parameterlist(LINK)
  1140. struct LOC_block *LINK;
  1141. {
  1142.   /* formal parameter list */
  1143.   types tp;
  1144.   long rf, sz, x, t0;
  1145.   boolean valpar;
  1146.   long SET[(long)ident / 32 + 2];
  1147.   symset SET1, SET2;
  1148.   _REC_tab *WITH;
  1149.   long SET3[(long)ident / 32 + 2];
  1150.   symset SET4;
  1151.  
  1152.   /*parameterlist*/
  1153.   insymbol();
  1154.   tp = notyp;
  1155.   rf = 0;
  1156.   sz = 0;
  1157.   P_addset(P_expset(SET, 0L), (int)ident);
  1158.   test(P_addset(SET, (int)varsy),
  1159.        P_setunion(SET2, LINK->fsys, P_expset(SET1, 1L << ((long)rparent))),
  1160.        7L, LINK);
  1161.   while (sy == (int)varsy || sy == (int)ident) {   /*while*/
  1162.     if (sy != varsy)
  1163.       valpar = true;
  1164.     else {   /*else*/
  1165.       insymbol();
  1166.       valpar = false;
  1167.     }
  1168.     t0 = t;
  1169.     entervariable(LINK);
  1170.     while (sy == comma) {   /*while*/
  1171.       insymbol();
  1172.       entervariable(LINK);
  1173.     }
  1174.     if (sy == colon) {
  1175.       insymbol();
  1176.       if (sy != ident)
  1177.     error(2L);
  1178.       else {   /*else*/
  1179.     x = loc(id, LINK);
  1180.     insymbol();
  1181.     if (x != 0) {
  1182.       WITH = &tab[x];
  1183.       if ((object)WITH->obj != type1)
  1184.         error(29L);
  1185.       else {   /*else*/
  1186.         tp = (types)WITH->typ;
  1187.         rf = SEXT(WITH->iref, 18);
  1188.         if (valpar)
  1189.           sz = WITH->adr;
  1190.         else
  1191.           sz = 1;
  1192.       }
  1193.     }
  1194.       }
  1195.       P_addset(P_expset(SET, 0L), (int)comma);
  1196.       test(P_expset(SET1, (1L << ((long)semicolon)) | (1L << ((long)rparent))),
  1197.        P_setunion(SET2, P_addset(SET, (int)ident), LINK->fsys), 14L,
  1198.        LINK);
  1199.     }  /*if*/
  1200.     else
  1201.       error(5L);
  1202.     while (t0 < t) {   /*while*/
  1203.       t0++;
  1204.       WITH = &tab[t0];
  1205.       WITH->typ = (unsigned)tp;
  1206.       WITH->iref = rf;
  1207.       WITH->normal = valpar;
  1208.       WITH->adr = LINK->dx;
  1209.       WITH->lev = LINK->level;
  1210.       LINK->dx += sz;   /*with*/
  1211.     }
  1212.     if (sy == rparent) {
  1213.       break;
  1214.     }  /*if*/
  1215.     if (sy == semicolon)
  1216.       insymbol();
  1217.     else {   /*else*/
  1218.       error(14L);
  1219.       if (sy == comma)
  1220.     insymbol();
  1221.     }
  1222.     P_addset(P_expset(SET3, 0L), (int)ident);
  1223.     test(P_addset(SET3, (int)varsy),
  1224.      P_setunion(SET4, P_expset(SET2, 1L << ((long)rparent)), LINK->fsys),
  1225.      6L, LINK);
  1226.   }
  1227.   if (sy == rparent) {
  1228.     insymbol();
  1229.     test(P_expset(SET1, (1L << ((long)semicolon)) | (1L << ((long)colon))),
  1230.      LINK->fsys, 6L, LINK);
  1231.   }  /*if*/
  1232.   else
  1233.     error(4L);
  1234. }
  1235.  
  1236.  
  1237. Local Void constantdeclaration(LINK)
  1238. struct LOC_block *LINK;
  1239. {
  1240.   conrec c;
  1241.   long SET[(long)ident / 32 + 2];
  1242.   symset SET1;
  1243.  
  1244.   /*constantdeclaration*/
  1245.   insymbol();
  1246.   test(P_addset(P_expset(SET, 0L), (int)ident), blockbegsys, 2L, LINK);
  1247.   while (sy == ident) {
  1248.     enter_(id, konstant, LINK);
  1249.     insymbol();
  1250.     if (sy == eql)
  1251.       insymbol();
  1252.     else {   /*else*/
  1253.       if (sy == becomes)
  1254.     insymbol();
  1255.     }
  1256.     P_addset(P_expset(SET, 0L), (int)semicolon);
  1257.     P_addset(SET, (int)comma);
  1258.     constant(P_setunion(SET1, P_addset(SET, (int)ident), LINK->fsys), &c,
  1259.          LINK);
  1260.     tab[t].typ = (unsigned)c.tp;
  1261.     tab[t].iref = 0;
  1262.     if (c.tp == reals) {
  1263.       enterreal(c.UU.r);
  1264.       tab[t].adr = c1;
  1265.     }  /*if*/
  1266.     else
  1267.       tab[t].adr = c.UU.i;
  1268.     testsemicolon(LINK);
  1269.   }  /*while*/
  1270. }
  1271.  
  1272.  
  1273. Local Void typedeclaration(LINK)
  1274. struct LOC_block *LINK;
  1275. {
  1276.   types tp;
  1277.   long rf, sz, t1;
  1278.   long SET[(long)ident / 32 + 2];
  1279.   symset SET1;
  1280.   _REC_tab *WITH;
  1281.  
  1282.   /*typedeclaration*/
  1283.   insymbol();
  1284.   test(P_addset(P_expset(SET, 0L), (int)ident), blockbegsys, 2L, LINK);
  1285.   while (sy == ident) {
  1286.     enter_(id, type1, LINK);
  1287.     t1 = t;
  1288.     insymbol();
  1289.     if (sy == eql)
  1290.       insymbol();
  1291.     else {   /*else*/
  1292.       error(16L);
  1293.       if (sy == becomes)
  1294.     insymbol();
  1295.     }
  1296.     P_addset(P_expset(SET, 0L), (int)semicolon);
  1297.     P_addset(SET, (int)comma);
  1298.     typ(P_setunion(SET1, P_addset(SET, (int)ident), LINK->fsys), &tp, &rf,
  1299.     &sz, LINK);
  1300.     WITH = &tab[t1];
  1301.     WITH->typ = (unsigned)tp;
  1302.     WITH->iref = rf;
  1303.     WITH->adr = sz;   /*with*/
  1304.     testsemicolon(LINK);
  1305.   }  /*while*/
  1306. }
  1307.  
  1308.  
  1309. Local Void variabledeclaration(LINK)
  1310. struct LOC_block *LINK;
  1311. {
  1312.   long t0, t1, rf, sz;
  1313.   types tp;
  1314.   long SET[(long)ident / 32 + 2];
  1315.   symset SET1;
  1316.   _REC_tab *WITH;
  1317.  
  1318.   /*variabledeclaration*/
  1319.   insymbol();
  1320.   while (sy == ident) {
  1321.     t0 = t;
  1322.     entervariable(LINK);
  1323.     while (sy == comma) {   /*while*/
  1324.       insymbol();
  1325.       entervariable(LINK);
  1326.     }
  1327.     if (sy == colon)
  1328.       insymbol();
  1329.     else
  1330.       error(5L);
  1331.     t1 = t;
  1332.     P_addset(P_expset(SET, 0L), (int)semicolon);
  1333.     P_addset(SET, (int)comma);
  1334.     typ(P_setunion(SET1, P_addset(SET, (int)ident), LINK->fsys), &tp, &rf,
  1335.     &sz, LINK);
  1336.     while (t0 < t1) {   /*while*/
  1337.       t0++;
  1338.       WITH = &tab[t0];
  1339.       WITH->typ = (unsigned)tp;
  1340.       WITH->iref = rf;
  1341.       WITH->lev = LINK->level;
  1342.       WITH->adr = LINK->dx;
  1343.       WITH->normal = true;
  1344.       LINK->dx += sz;   /*with*/
  1345.     }
  1346.     testsemicolon(LINK);
  1347.   }  /*while*/
  1348. }
  1349.  
  1350.  
  1351. Local Void procdeclaration(LINK)
  1352. struct LOC_block *LINK;
  1353. {
  1354.   boolean isfun;
  1355.   symset SET, SET1;
  1356.  
  1357.   /*procdeclaration*/
  1358.   isfun = (sy == functionsy);
  1359.   insymbol();
  1360.   if (sy != ident) {   /*if*/
  1361.     error(2L);
  1362.     memcpy(id, "          ", sizeof(alfa_));
  1363.   }
  1364.   if (isfun)
  1365.     enter_(id, funktion, LINK);
  1366.   else
  1367.     enter_(id, prozedure, LINK);
  1368.   tab[t].normal = true;
  1369.   insymbol();
  1370.   block(P_setunion(SET1, P_expset(SET, 1L << ((long)semicolon)), LINK->fsys),
  1371.     isfun, LINK->level + 1);
  1372.   if (sy == semicolon)   /*exit*/
  1373.     insymbol();
  1374.   else
  1375.     error(14L);
  1376.   emit(isfun + 32L);
  1377. }
  1378.  
  1379. /* Local variables for statement: */
  1380. struct LOC_statement {
  1381.   struct LOC_block *LINK;
  1382.   symset fsys;
  1383.   long i;
  1384.   item x;
  1385. } ;
  1386.  
  1387. Local Void expression PP((long *fsys, item *x, struct LOC_statement *LINK));
  1388.  
  1389.  
  1390. Local Void selector(fsys, v, LINK)
  1391. long *fsys;
  1392. item *v;
  1393. struct LOC_statement *LINK;
  1394. {  /* sy in [lparent,lbrack,period] */
  1395.   long a, j;
  1396.   symset SET, SET1;
  1397.  
  1398.   /*selector*/
  1399.   do {
  1400.     if (sy == period) {  /* field selector */
  1401.       insymbol();
  1402.       if (sy != ident)
  1403.     error(2L);
  1404.       else {
  1405.     if (v->typ != records)
  1406.       error(31L);
  1407.     else   /*else*/
  1408.     {  /* search field identifier */
  1409.       j = btab[v->iref - 1].last;
  1410.       memcpy(tab[0].name, id, sizeof(alfa_));
  1411.       while (strncmp(tab[j].name, id, sizeof(alfa_)))
  1412.         j = tab[j].link;
  1413.       if (j == 0)
  1414.         error(0L);
  1415.       v->typ = (types)tab[j].typ;
  1416.       v->iref = SEXT(tab[j].iref, 18);
  1417.       a = tab[j].adr;
  1418.       if (a != 0)
  1419.         emit1(9L, a);
  1420.     }
  1421.     insymbol();
  1422.       }  /*else*/
  1423.     }  /*if*/
  1424.     else {  /* array selector */
  1425.       if (sy != lbrack)
  1426.     error(11L);
  1427.       do {
  1428.     insymbol();
  1429.     expression(P_setunion(SET1, fsys,
  1430.         P_expset(SET, (1L << ((long)comma)) | (1L << ((long)rbrack)))),
  1431.       &LINK->x, LINK);
  1432.     if (v->typ != arrays)
  1433.       error(28L);
  1434.     else {
  1435.       a = v->iref;
  1436.       if ((types)atab[a - 1].inxtyp != LINK->x.typ)
  1437.         error(26L);
  1438.       else {
  1439.         if (SEXT(atab[a - 1].elsize, 18) == 1)
  1440.           emit1(20L, a);
  1441.         else
  1442.           emit1(21L, a);
  1443.       }
  1444.       v->typ = (types)atab[a - 1].eltyp;
  1445.       v->iref = SEXT(atab[a - 1].eliref, 18);
  1446.     }  /*else*/
  1447.       } while (sy == comma);
  1448.       if (sy == rbrack)
  1449.     insymbol();
  1450.       else {
  1451.     error(12L);
  1452.     if (sy == rparent)
  1453.       insymbol();
  1454.       }  /*else*/
  1455.     }  /*else*/
  1456.   } while ((unsigned long)sy < 32 &&
  1457.        ((1L << ((long)sy)) & ((1L << ((long)lbrack)) |
  1458.           (1L << ((long)lparent)) | (1L << ((long)period)))) != 0);
  1459.   test(fsys, P_expset(SET, 0L), 6L, LINK->LINK);
  1460. }
  1461.  
  1462.  
  1463. Local Void call(fsys, i, LINK)
  1464. long *fsys;
  1465. long i;
  1466. struct LOC_statement *LINK;
  1467. {   /* mark stack */
  1468.   item x;
  1469.   long lastp, cp, k;
  1470.   symset SET, SET1;
  1471.  
  1472.   /*call*/
  1473.   emit1(18L, i);
  1474.   lastp = btab[SEXT(tab[i].iref, 18) - 1].lastpar;
  1475.   cp = i;
  1476.   if (sy == lparent)   /*if*/
  1477.   {  /* actual parameter list */
  1478.     do {
  1479.       insymbol();
  1480.       if (cp >= lastp)
  1481.     error(39L);
  1482.       else {   /*else*/
  1483.     cp++;
  1484.     if (tab[cp].normal) {  /* value parameter */
  1485.       expression(P_setunion(SET1, fsys, P_expset(SET,
  1486.              (1L << ((long)comma)) | (1L << ((long)colon)) |
  1487.              (1L << ((long)rparent)))), &x, LINK);
  1488. /* p2c: temp.p, line 2560: 
  1489.  * Note: Line breaker spent 1.0 seconds, 5000 tries on line 1487 [251] */
  1490.       if (x.typ == (types)tab[cp].typ) {
  1491.         if (x.iref != SEXT(tab[cp].iref, 18))
  1492.           error(36L);
  1493.         else {
  1494.           if (x.typ == arrays)
  1495.         emit1(22L, (long)SEXT(atab[x.iref - 1].size, 18));
  1496.           else {
  1497.         if (x.typ == records)
  1498.           emit1(22L, btab[x.iref - 1].vsize);
  1499.           }
  1500.         }
  1501.       }  /*if*/
  1502.       else {
  1503.         if (x.typ == ints && (types)tab[cp].typ == reals)
  1504.           emit1(26L, 0L);
  1505.         else {
  1506.           if (x.typ != notyp)
  1507.         error(36L);
  1508.         }
  1509.       }
  1510.     }  /*if*/
  1511.     else {  /* varaiable parameter */
  1512.       if (sy != ident)
  1513.         error(2L);
  1514.       else {
  1515.         k = loc(id, LINK->LINK);
  1516.         insymbol();
  1517.         if (k != 0) {
  1518.           if ((object)tab[k].obj != variable)
  1519.         error(37L);
  1520.           x.typ = (types)tab[k].typ;
  1521.           x.iref = SEXT(tab[k].iref, 18);
  1522.           if (tab[k].normal)
  1523.         emit2(0L, (long)tab[k].lev, tab[k].adr);
  1524.           else
  1525.         emit2(1L, (long)tab[k].lev, tab[k].adr);
  1526.           if ((unsigned long)sy < 32 &&
  1527.           ((1L << ((long)sy)) & ((1L << ((long)lbrack)) |
  1528.              (1L << ((long)lparent)) | (1L << ((long)period)))) != 0)
  1529.         selector(P_setunion(SET1, fsys, P_expset(SET,
  1530.                  (1L << ((long)comma)) | (1L << ((long)colon)) |
  1531.                  (1L << ((long)rparent)))), &x, LINK);
  1532. /* p2c: temp.p, line 2560: 
  1533.  * Note: Line breaker spent 0.0 seconds, 5000 tries on line 1531 [251] */
  1534.           if (x.typ != (types)tab[cp].typ ||
  1535.           x.iref != SEXT(tab[cp].iref, 18))
  1536.         error(36L);
  1537.         }  /*if*/
  1538.       }  /*else*/
  1539.     }  /*else*/
  1540.       }
  1541.       test(P_expset(SET, (1L << ((long)comma)) | (1L << ((long)rparent))),
  1542.        fsys, 6L, LINK->LINK);
  1543.     } while (sy == comma);
  1544.     if (sy == rparent)
  1545.       insymbol();
  1546.     else
  1547.       error(4L);
  1548.   }
  1549.   if (cp < lastp)
  1550.     error(39L);
  1551.   /* too few actual parameters */
  1552.   emit1(19L, btab[SEXT(tab[i].iref, 18) - 1].psize - 1);
  1553.   if (tab[i].lev < LINK->LINK->level)
  1554.     emit2(3L, (long)tab[i].lev, LINK->LINK->level);
  1555. }
  1556.  
  1557.  
  1558. Local types resulttype(a, b, LINK)
  1559. types a, b;
  1560. struct LOC_statement *LINK;
  1561. {
  1562.   types Result;
  1563.  
  1564.   /*resulttype*/
  1565.   if ((long)a > (long)reals || (long)b > (long)reals) {
  1566.     error(33L);
  1567.     return notyp;
  1568.   }  /*if*/
  1569.   if (a == notyp || b == notyp)
  1570.     return notyp;
  1571.   if (a == ints) {
  1572.     if (b == ints)
  1573.       return ints;
  1574.     Result = reals;
  1575.     emit1(26L, 1L);
  1576.     return Result;
  1577.   }
  1578.   Result = reals;
  1579.   if (b == ints)
  1580.     emit1(26L, 0L);
  1581.   return Result;
  1582.  
  1583.   /*else*/
  1584.   /*else*/
  1585. }
  1586.  
  1587. /* Local variables for expression: */
  1588. struct LOC_expression {
  1589.   struct LOC_statement *LINK;
  1590. } ;
  1591.  
  1592. /* Local variables for simpleexpression: */
  1593. struct LOC_simpleexpression {
  1594.   struct LOC_expression *LINK;
  1595. } ;
  1596.  
  1597. /* Local variables for term: */
  1598. struct LOC_term {
  1599.   struct LOC_simpleexpression *LINK;
  1600. } ;
  1601.  
  1602. /* Local variables for factor: */
  1603. struct LOC_factor {
  1604.   struct LOC_term *LINK;
  1605.   symset fsys;
  1606.   item *x;
  1607.   long i;
  1608. } ;
  1609.  
  1610.  
  1611. Local Void standfct(n, LINK)
  1612. long n;
  1613. struct LOC_factor *LINK;
  1614. {  /* standard function number n */
  1615.   typset ts;
  1616.   symset SET, SET1;
  1617.  
  1618.   /*standfct*/
  1619.   if (sy == lparent)
  1620.     insymbol();
  1621.   else
  1622.     error(9L);
  1623.   if (n < 17) {
  1624.     expression(P_setunion(SET1, LINK->fsys,
  1625.               P_expset(SET, 1L << ((long)rparent))), LINK->x,
  1626.            LINK->LINK->LINK->LINK->LINK);
  1627.     switch (n) {   /*case*/
  1628.  
  1629.     case 0:
  1630.     case 2:   /* abs */
  1631.       ts = (1L << ((long)ints)) | (1L << ((long)reals));
  1632.       tab[LINK->i].typ = (unsigned)LINK->x->typ;
  1633.       if (LINK->x->typ == reals)
  1634.     n++;
  1635.       break;
  1636.       /* sqr */
  1637.       /*0*/
  1638.  
  1639.     case 4:
  1640.     case 5:   /* odd */
  1641.       ts = 1L << ((long)ints);
  1642.       break;
  1643.       /* chr */
  1644.  
  1645.     case 6:   /* ord */
  1646.       ts = (1L << ((long)ints)) | (1L << ((long)bools)) | (1L << ((long)chars));
  1647.       break;
  1648.  
  1649.     case 7:
  1650.     case 8:   /* succ */
  1651.       ts = 1L << ((long)chars);
  1652.       break;
  1653.       /* pred */
  1654.  
  1655.     case 9:
  1656.     case 10:
  1657.     case 11:
  1658.     case 12:
  1659.     case 13:
  1660.     case 14:
  1661.     case 15:
  1662.     case 16:   /* round */
  1663.       /* co
  1664.       s   */
  1665.       ts = (1L << ((long)ints)) | (1L << ((long)reals));
  1666.       if (LINK->x->typ == ints)
  1667.     emit1(26L, 0L);
  1668.       break;
  1669.       /* trunc */
  1670.       /* sin   */
  1671.       /*9*/
  1672.     }
  1673.     if (((1L << ((long)LINK->x->typ)) & ts) != 0)
  1674.       emit1(8L, n);
  1675.     else {
  1676.       if (LINK->x->typ != notyp)
  1677.     error(48L);
  1678.     }
  1679.   }  /*if*/
  1680.   else   /*else*/
  1681.   {  /* n in [17,18] */
  1682.     if (sy != ident)
  1683.       error(2L);
  1684.     else {
  1685.       if (strncmp(id, "input     ", sizeof(alfa_)))
  1686.     error(0L);
  1687.       else
  1688.     insymbol();
  1689.     }
  1690.     emit1(8L, n);
  1691.   }
  1692.   LINK->x->typ = (types)tab[LINK->i].typ;
  1693.   if (sy == rparent)
  1694.     insymbol();
  1695.   else
  1696.     error(4L);
  1697. }
  1698.  
  1699.  
  1700. Local Void factor(fsys_, x_, LINK)
  1701. long *fsys_;
  1702. item *x_;
  1703. struct LOC_term *LINK;
  1704. {
  1705.   struct LOC_factor V;
  1706.   long f;
  1707.   _REC_tab *WITH;
  1708.   symset SET, SET1;
  1709.  
  1710.  
  1711.   V.LINK = LINK;
  1712.   /*factor*/
  1713.   P_setcpy(V.fsys, fsys_);
  1714.   V.x = x_;
  1715.   V.x->typ = notyp;
  1716.   V.x->iref = 0;
  1717.   test(facbegsys, V.fsys, 58L, LINK->LINK->LINK->LINK->LINK);
  1718.   while (P_inset(sy, facbegsys)) {
  1719.     if (sy == ident) {
  1720.       V.i = loc(id, LINK->LINK->LINK->LINK->LINK);
  1721.       insymbol();
  1722.       WITH = &tab[V.i];
  1723.       switch ((object)WITH->obj) {
  1724.  
  1725.       case konstant:   /*konstant*/
  1726.     V.x->typ = (types)WITH->typ;
  1727.     V.x->iref = 0;
  1728.     if (V.x->typ == reals) {
  1729.       if (V.x->typ == reals)
  1730.         emit1(25L, WITH->adr);
  1731.       else
  1732.         emit1(24L, WITH->adr);
  1733.     }
  1734.     break;
  1735.  
  1736.       case variable:   /*variable*/
  1737.     V.x->typ = (types)WITH->typ;
  1738.     V.x->iref = SEXT(WITH->iref, 18);
  1739.     if ((unsigned long)sy < 32 &&
  1740.         ((1L << ((long)sy)) & ((1L << ((long)lbrack)) |
  1741.            (1L << ((long)lparent)) | (1L << ((long)period)))) != 0) {
  1742.       if (WITH->normal)
  1743.         f = 0;
  1744.       else
  1745.         f = 1;
  1746.       emit2(f, (long)WITH->lev, WITH->adr);
  1747.       selector(V.fsys, V.x, LINK->LINK->LINK->LINK);
  1748.       if (((1L << ((long)V.x->typ)) & stantyps) != 0)
  1749.         emit(34L);
  1750.     }  /*if*/
  1751.     else {
  1752.       if (((1L << ((long)V.x->typ)) & stantyps) != 0) {
  1753.         if (WITH->normal)
  1754.           f = 1;
  1755.         else
  1756.           f = 2;
  1757.       } else {
  1758.         if (WITH->normal)
  1759.           f = 0;
  1760.         else
  1761.           f = 1;
  1762.       }
  1763.       emit2(f, (long)WITH->lev, WITH->adr);
  1764.     }  /*else*/
  1765.     break;
  1766.  
  1767.       case type1:
  1768.       case prozedure:
  1769.     error(44L);
  1770.     break;
  1771.  
  1772.       case funktion:
  1773.     V.x->typ = (types)WITH->typ;
  1774.     if (WITH->lev != 0)
  1775.       call(V.fsys, V.i, LINK->LINK->LINK->LINK);
  1776.     else
  1777.       standfct(WITH->adr, &V);
  1778.     break;
  1779.     /*funktion*/
  1780.       }/*case*/
  1781.     }  /*if*/
  1782.     else {
  1783.       if ((unsigned long)sy < 32 &&
  1784.       ((1L << ((long)sy)) & ((1L << ((long)charcon)) |
  1785.          (1L << ((long)intcon)) | (1L << ((long)realcon)))) != 0) {
  1786.     if (sy == realcon) {
  1787.       V.x->typ = reals;
  1788.       enterreal(rnum);
  1789.       emit1(25L, c1);
  1790.     }  /*if*/
  1791.     else {   /*else*/
  1792.       if (sy == charcon)
  1793.         V.x->typ = chars;
  1794.       else
  1795.         V.x->typ = ints;
  1796.       emit1(24L, inum);
  1797.     }
  1798.     V.x->iref = 0;
  1799.     insymbol();
  1800.       }  /*if*/
  1801.       else {
  1802.     if (sy == lparent) {
  1803.       insymbol();
  1804.       expression(P_setunion(SET1, V.fsys,
  1805.                 P_expset(SET, 1L << ((long)rparent))), V.x,
  1806.              LINK->LINK->LINK->LINK);
  1807.       if (sy == rparent)
  1808.         insymbol();
  1809.       else
  1810.         error(4L);
  1811.     }  /*if*/
  1812.     else {
  1813.       if (sy == notsy) {   /*if*/
  1814.         insymbol();
  1815.         factor(V.fsys, V.x, LINK);
  1816.         if (V.x->typ == bools)
  1817.           emit(35L);
  1818.         else {
  1819.           if (V.x->typ != notyp)
  1820.         error(32L);
  1821.         }
  1822.       }
  1823.     }
  1824.       }
  1825.     }
  1826.     test(V.fsys, facbegsys, 6L, LINK->LINK->LINK->LINK->LINK);
  1827.   }  /*while*/
  1828. }
  1829.  
  1830.  
  1831. Local Void term(fsys, x, LINK)
  1832. long *fsys;
  1833. item *x;
  1834. struct LOC_simpleexpression *LINK;
  1835. {
  1836.   struct LOC_term V;
  1837.   item y;
  1838.   symbol op;
  1839.   symset SET, SET1;
  1840.  
  1841.  
  1842.   V.LINK = LINK;
  1843.   /*term*/
  1844.   factor(P_setunion(SET1, fsys, P_expset(SET,
  1845.          (1L << ((long)times)) | (1L << ((long)rdiv)) | (1L << ((long)idiv)) |
  1846.          (1L << ((long)imod)) | (1L << ((long)andsy)))), x, &V);
  1847. /* p2c: temp.p, line 2560: 
  1848.  * Note: Line breaker spent 1.0 seconds, 5000 tries on line 1846 [251] */
  1849.   while ((unsigned long)sy < 32 &&
  1850.      ((1L << ((long)sy)) & ((1L << ((long)times)) | (1L << ((long)rdiv)) |
  1851.                 (1L << ((long)idiv)) | (1L << ((long)imod)) |
  1852.                 (1L << ((long)andsy)))) != 0) {
  1853.     op = sy;
  1854.     insymbol();
  1855.     factor(P_setunion(SET1, fsys,
  1856.          P_expset(SET, (1L << ((long)times)) | (1L << ((long)rdiv)) |
  1857.                (1L << ((long)idiv)) | (1L << ((long)imod)) |
  1858.                (1L << ((long)andsy)))), &y, &V);
  1859. /* p2c: temp.p, line 2560: 
  1860.  * Note: Line breaker spent 1.0 seconds, 5000 tries on line 1858 [251] */
  1861.     if (op == times) {
  1862.       x->typ = resulttype(x->typ, y.typ, LINK->LINK->LINK);
  1863.       switch (x->typ) {
  1864.  
  1865.       case notyp:
  1866.     /* blank case */
  1867.     break;
  1868.  
  1869.       case ints:
  1870.     emit(57L);
  1871.     break;
  1872.  
  1873.       case reals:
  1874.     emit(60L);
  1875.     break;
  1876.       }/*case*/
  1877.       continue;
  1878.     }  /*if*/
  1879.     if (op == rdiv) {
  1880.       if (x->typ == ints) {   /*if*/
  1881.     emit1(26L, 1L);
  1882.     x->typ = reals;
  1883.       }
  1884.       if (y.typ == ints) {   /*if*/
  1885.     emit1(26L, 0L);
  1886.     y.typ = reals;
  1887.       }
  1888.       if (x->typ == reals && y.typ == reals)
  1889.     emit(61L);
  1890.       else {
  1891.     if (x->typ != notyp && y.typ != notyp)
  1892.       error(33L);
  1893.     x->typ = notyp;
  1894.       }  /*else*/
  1895.       continue;
  1896.     }  /*if*/
  1897.     if (op == andsy) {
  1898.       if (x->typ == bools && y.typ == bools)
  1899.     emit(56L);
  1900.       else {
  1901.     if (x->typ != notyp && y.typ != notyp)
  1902.       error(32L);
  1903.     x->typ = notyp;
  1904.       }  /*else*/
  1905.       continue;
  1906.     }  /*if*/
  1907.     if (x->typ == ints && y.typ == ints) {
  1908.       if (op == idiv)
  1909.     emit(58L);
  1910.       else
  1911.     emit(59L);
  1912.     } else {
  1913.       if (x->typ != notyp && y.typ != notyp)
  1914.     error(34L);
  1915.       x->typ = notyp;
  1916.     }  /*else*/
  1917.   }  /*while*/
  1918.  
  1919.   /* op in idiv,imod */
  1920.   /*else*/
  1921. }
  1922.  
  1923.  
  1924. Local Void simpleexpression(fsys, x, LINK)
  1925. long *fsys;
  1926. item *x;
  1927. struct LOC_expression *LINK;
  1928. {
  1929.   struct LOC_simpleexpression V;
  1930.   item y;
  1931.   symbol op;
  1932.   symset SET, SET1;
  1933.  
  1934.  
  1935.   V.LINK = LINK;
  1936.   /*simpleexpression*/
  1937.   if ((unsigned long)sy < 32 &&
  1938.       ((1L << ((long)sy)) & ((1L << ((long)plus)) | (1L << ((long)minus)))) != 0) {
  1939.     op = sy;
  1940.     insymbol();
  1941.     term(P_setunion(SET1, fsys, P_expset(SET,
  1942.               (1L << ((long)plus)) | (1L << ((long)minus)))), x, &V);
  1943.     if ((long)x->typ > (long)reals)
  1944.       error(33L);
  1945.     else {
  1946.       if (op == minus)
  1947.     emit(36L);
  1948.     }
  1949.   }  /*if*/
  1950.   else
  1951.     term(P_setunion(SET1, fsys, P_expset(SET,
  1952.          (1L << ((long)plus)) | (1L << ((long)minus)) | (1L << ((long)orsy)))),
  1953.      x, &V);
  1954.   while ((unsigned long)sy < 32 &&
  1955.      ((1L << ((long)sy)) & ((1L << ((long)plus)) | (1L << ((long)minus)) |
  1956.                 (1L << ((long)orsy)))) != 0) {
  1957.     op = sy;
  1958.     insymbol();
  1959.     term(P_setunion(SET1, fsys, P_expset(SET,
  1960.          (1L << ((long)plus)) | (1L << ((long)minus)) | (1L << ((long)orsy)))),
  1961.      &y, &V);
  1962.     if (op == orsy) {
  1963.       if (x->typ == bools && y.typ == bools)
  1964.     emit(51L);
  1965.       else {
  1966.     if (x->typ != notyp && y.typ != notyp)
  1967.       error(32L);
  1968.     x->typ = notyp;
  1969.       }  /*else*/
  1970.       continue;
  1971.     }  /*if*/
  1972.     x->typ = resulttype(x->typ, y.typ, LINK->LINK);
  1973.     switch (x->typ) {
  1974.  
  1975.     case notyp:
  1976.       /* blank case */
  1977.       break;
  1978.  
  1979.     case ints:
  1980.       if (op == plus)
  1981.     emit(52L);
  1982.       else
  1983.     emit(53L);
  1984.       break;
  1985.  
  1986.     case reals:
  1987.       if (op == plus)
  1988.     emit(54L);
  1989.       else
  1990.     emit(55L);
  1991.       break;
  1992.     }/*case*/
  1993.   }  /*while*/
  1994.  
  1995.   /*else*/
  1996. }
  1997.  
  1998.  
  1999. Local Void expression(fsys, x, LINK)
  2000. long *fsys;
  2001. item *x;
  2002. struct LOC_statement *LINK;
  2003. {
  2004.   struct LOC_expression V;
  2005.   item y;
  2006.   symbol op;
  2007.   symset SET, SET1;
  2008.  
  2009.  
  2010.   V.LINK = LINK;
  2011.   /*expression*/
  2012.   simpleexpression(P_setunion(SET1, fsys, P_expset(SET,
  2013.     (1L << ((long)eql)) | (1L << ((long)neq)) | (1L << ((long)lss)) |
  2014.       (1L << ((long)leq)) | (1L << ((long)gtr)) | (1L << ((long)geq)))),
  2015.     x, &V);
  2016. /* p2c: temp.p, line 2560: 
  2017.  * Note: Line breaker spent 1.0 seconds, 5000 tries on line 2015 [251] */
  2018.   if ((unsigned long)sy >= 32 ||
  2019.       ((1L << ((long)sy)) & ((1L << ((long)eql)) | (1L << ((long)neq)) |
  2020.      (1L << ((long)lss)) | (1L << ((long)leq)) | (1L << ((long)gtr)) |
  2021.      (1L << ((long)geq)))) == 0) {
  2022.     return;
  2023.   }  /*if*/
  2024.   op = sy;
  2025.   insymbol();
  2026.   simpleexpression(fsys, &y, &V);
  2027.   if (((1L << ((long)x->typ)) & ((1L << ((long)notyp)) | (1L << ((long)ints)) |
  2028.      (1L << ((long)bools)) | (1L << ((long)chars)))) != 0 &&
  2029.       x->typ == y.typ) {
  2030.     switch (op) {
  2031.  
  2032.     case eql:
  2033.       emit(45L);
  2034.       break;
  2035.  
  2036.     case neq:
  2037.       emit(46L);
  2038.       break;
  2039.  
  2040.     case lss:
  2041.       emit(47L);
  2042.       break;
  2043.  
  2044.     case leq:
  2045.       emit(48L);
  2046.       break;
  2047.  
  2048.     case gtr:
  2049.       emit(49L);
  2050.       break;
  2051.  
  2052.     case geq:
  2053.       emit(50L);
  2054.       break;
  2055.     }/*case*/
  2056.   } else {   /*else*/
  2057.     if (x->typ == ints) {
  2058.       x->typ = reals;
  2059.       emit1(26L, 1L);
  2060.     }  /*if*/
  2061.     else {
  2062.       if (y.typ == ints) {   /*if*/
  2063.     y.typ = reals;
  2064.     emit1(26L, 0L);
  2065.       }
  2066.     }
  2067.     if (x->typ == reals && y.typ == reals) {
  2068.       switch (op) {
  2069.  
  2070.       case eql:
  2071.     emit(39L);
  2072.     break;
  2073.  
  2074.       case neq:
  2075.     emit(40L);
  2076.     break;
  2077.  
  2078.       case lss:
  2079.     emit(41L);
  2080.     break;
  2081.  
  2082.       case leq:
  2083.     emit(42L);
  2084.     break;
  2085.  
  2086.       case gtr:
  2087.     emit(43L);
  2088.     break;
  2089.  
  2090.       case geq:
  2091.     emit(44L);
  2092.     break;
  2093.       }/*case*/
  2094.     } else
  2095.       error(35L);
  2096.   }
  2097.   x->typ = bools;
  2098.  
  2099.  
  2100. }
  2101.  
  2102.  
  2103. Local Void assignment(lv, ad, LINK)
  2104. long lv, ad;
  2105. struct LOC_statement *LINK;
  2106. {
  2107.   item x, y;
  2108.   long f;
  2109.   symset SET, SET1;
  2110.  
  2111.   /* tab[i].obj in [variable,prozedure]*/
  2112.  
  2113.   /*assignment*/
  2114.   x.typ = (types)tab[LINK->i].typ;
  2115.   x.iref = SEXT(tab[LINK->i].iref, 18);
  2116.   if (tab[LINK->i].normal)
  2117.     f = 0;
  2118.   else
  2119.     f = 1;
  2120.   emit2(f, lv, ad);
  2121.   if ((unsigned long)sy < 32 &&
  2122.       ((1L << ((long)sy)) & ((1L << ((long)lbrack)) |
  2123.      (1L << ((long)lparent)) | (1L << ((long)period)))) != 0)
  2124.     selector(P_setunion(SET1,
  2125.            P_expset(SET, (1L << ((long)becomes)) | (1L << ((long)eql))),
  2126.            LINK->fsys), &x, LINK);
  2127.   if (sy == becomes)
  2128.     insymbol();
  2129.   else {   /*else*/
  2130.     error(51L);
  2131.     if (sy == eql)
  2132.       insymbol();
  2133.   }
  2134.   expression(LINK->fsys, &y, LINK);
  2135.   if (x.typ == y.typ) {
  2136.     if (((1L << ((long)x.typ)) & stantyps) != 0) {
  2137.       emit(38L);
  2138.       return;
  2139.     }
  2140.     if (x.iref != y.iref) {
  2141.       error(46L);
  2142.       return;
  2143.     }
  2144.     if (x.typ == arrays)
  2145.       emit1(23L, (long)SEXT(atab[x.iref - 1].size, 18));
  2146.     else
  2147.       emit1(23L, btab[x.iref - 1].vsize);
  2148.     return;
  2149.   }
  2150.   if (x.typ == reals && y.typ == ints) {
  2151.     emit1(26L, 0L);
  2152.     emit(38L);
  2153.   }  /*if*/
  2154.   else {
  2155.     if (x.typ != notyp && y.typ != notyp)
  2156.       error(46L);
  2157.   }
  2158. }
  2159.  
  2160.  
  2161. Local Void compoundstatement(LINK)
  2162. struct LOC_statement *LINK;
  2163. {
  2164.   symset SET, SET1;
  2165.   long SET2[(long)endsy / 32 + 2];
  2166.   symset SET3;
  2167.  
  2168.   /*compoundstatement*/
  2169.   insymbol();
  2170.   while (P_inset(sy, P_setunion(SET1, P_expset(SET, 1L << ((long)semicolon)),
  2171.                 statbegsys)))
  2172.   {   /*while*/
  2173.     if (sy == semicolon)
  2174.       insymbol();
  2175.     else
  2176.       error(14L);
  2177.     P_addset(P_expset(SET2, 0L), (int)semicolon);
  2178.     statement(P_setunion(SET3, P_addset(SET2, (int)endsy), LINK->fsys),
  2179.           LINK->LINK);
  2180.   }
  2181.   if (sy == endsy)
  2182.     insymbol();
  2183.   else
  2184.     error(57L);
  2185. }
  2186.  
  2187.  
  2188. Local Void ifstatement(LINK)
  2189. struct LOC_statement *LINK;
  2190. {
  2191.   item x;
  2192.   long lc1, lc2;
  2193.   symset SET, SET1;
  2194.   long SET2[(long)elsesy / 32 + 2];
  2195.  
  2196.   /*ifstatement*/
  2197.   insymbol();
  2198.   P_addset(P_expset(SET, 0L), (int)thensy);
  2199.   expression(P_setunion(SET1, LINK->fsys, P_addset(SET, (int)dosy)), &x, LINK);
  2200.   if (((1L << ((long)x.typ)) & ((1L << ((long)bools)) | (1L << ((long)notyp)))) == 0)
  2201.     error(17L);
  2202.   lc1 = lc;
  2203.   emit(11L);
  2204.   /* jmpc */
  2205.   if (sy == thensy)
  2206.     insymbol();
  2207.   else {   /*else*/
  2208.     error(52L);
  2209.     if (sy == dosy)
  2210.       insymbol();
  2211.   }
  2212.   statement(P_setunion(SET, LINK->fsys,
  2213.                P_addset(P_expset(SET2, 0L), (int)elsesy)),
  2214.         LINK->LINK);
  2215.   if (sy != elsesy) {
  2216.     code[lc1].y = lc;
  2217.     return;
  2218.   }  /*if*/
  2219.   insymbol();
  2220.   lc2 = lc;
  2221.   emit(10L);
  2222.   code[lc1].y = lc;
  2223.   statement(LINK->fsys, LINK->LINK);
  2224.   code[lc2].y = lc;
  2225. }
  2226.  
  2227. /* Local variables for casestatement: */
  2228. struct LOC_casestatement {
  2229.   struct LOC_statement *LINK;
  2230.   item x;
  2231.   long i, j;
  2232.   _REC_casetab casetab[csmax];
  2233.   long exittab[csmax];
  2234. } ;
  2235.  
  2236.  
  2237. Local Void caselabel(LINK)
  2238. struct LOC_casestatement *LINK;
  2239. {
  2240.   conrec lab;
  2241.   long k;
  2242.   symset SET, SET1;
  2243.  
  2244.   /*caselabel*/
  2245.   constant(P_setunion(SET1, LINK->LINK->fsys,
  2246.          P_expset(SET, (1L << ((long)comma)) | (1L << ((long)colon)))),
  2247.        &lab, LINK->LINK->LINK);
  2248.   if (lab.tp != LINK->x.typ) {
  2249.     error(47L);
  2250.     return;
  2251.   }
  2252.   if (LINK->i == csmax) {
  2253.     fatal(6L);
  2254.     return;
  2255.   }
  2256.   LINK->i++;
  2257.   k = 0;
  2258.   LINK->casetab[LINK->i - 1].val = lab.UU.i;
  2259.   LINK->casetab[LINK->i - 1].lc = lc;
  2260.   do {
  2261.     k++;
  2262.   } while (LINK->casetab[k - 1].val != lab.UU.i);
  2263.   if (k < LINK->i)
  2264.     error(1L);
  2265.   /* multiple def */
  2266.  
  2267.   /*else*/
  2268. }
  2269.  
  2270.  
  2271. Local Void onecase(LINK)
  2272. struct LOC_casestatement *LINK;
  2273. {
  2274.   long SET[(long)endsy / 32 + 2];
  2275.   symset SET1;
  2276.  
  2277.   /*onecase*/
  2278.   if (!P_inset(sy, constbegsys)) {
  2279.     return;
  2280.   }  /*if*/
  2281.   caselabel(LINK);
  2282.   while (sy == comma) {   /*while*/
  2283.     insymbol();
  2284.     caselabel(LINK);
  2285.   }
  2286.   if (sy == colon)
  2287.     insymbol();
  2288.   else
  2289.     error(5L);
  2290.   P_addset(P_expset(SET, 0L), (int)semicolon);
  2291.   statement(P_setunion(SET1, P_addset(SET, (int)endsy), LINK->LINK->fsys),
  2292.         LINK->LINK->LINK);
  2293.   LINK->j++;
  2294.   LINK->exittab[LINK->j - 1] = lc;
  2295.   emit(10L);
  2296. }
  2297.  
  2298.  
  2299. Local Void casestatement(LINK)
  2300. struct LOC_statement *LINK;
  2301. {
  2302.   struct LOC_casestatement V;
  2303.   long k, lc1;
  2304.   long SET[(long)ofsy / 32 + 2];
  2305.   symset SET1;
  2306.   long FORLIM;
  2307.  
  2308.  
  2309.   V.LINK = LINK;
  2310.   /*casestatement*/
  2311.   insymbol();
  2312.   V.i = 0;
  2313.   V.j = 0;
  2314.   P_addset(P_expset(SET, 0L), (int)ofsy);
  2315.   P_addset(SET, (int)comma);
  2316.   expression(P_setunion(SET1, LINK->fsys, P_addset(SET, (int)colon)), &V.x,
  2317.          LINK);
  2318.   if (((1L << ((long)V.x.typ)) & ((1L << ((long)ints)) | (1L << ((long)bools)) |
  2319.      (1L << ((long)chars)) | (1L << ((long)notyp)))) == 0)
  2320.     error(23L);
  2321.   lc1 = lc;
  2322.   emit(12L);
  2323.   /* jmpx */
  2324.   if (sy == ofsy)
  2325.     insymbol();
  2326.   else
  2327.     error(8L);
  2328.   onecase(&V);
  2329.   while (sy == semicolon) {   /*while*/
  2330.     insymbol();
  2331.     onecase(&V);
  2332.   }
  2333.   code[lc1].y = lc;
  2334.   FORLIM = V.i;
  2335.   for (k = 0; k < FORLIM; k++) {   /*for*/
  2336.     emit1(13L, V.casetab[k].val);
  2337.     emit1(13L, V.casetab[k].lc);
  2338.   }
  2339.   emit1(10L, 0L);
  2340.   FORLIM = V.j;
  2341.   for (k = 0; k < FORLIM; k++)
  2342.     code[V.exittab[k]].y = lc;
  2343.   if (sy == endsy)
  2344.     insymbol();
  2345.   else
  2346.     error(57L);
  2347. }
  2348.  
  2349.  
  2350. Local Void repeatstatement(LINK)
  2351. struct LOC_statement *LINK;
  2352. {
  2353.   item x;
  2354.   long lc1;
  2355.   long SET[(long)untilsy / 32 + 2];
  2356.   symset SET1, SET2, SET3;
  2357.  
  2358.   /*repeatstatement*/
  2359.   lc1 = lc;
  2360.   insymbol();
  2361.   P_addset(P_expset(SET, 0L), (int)semicolon);
  2362.   statement(P_setunion(SET1, P_addset(SET, (int)untilsy), LINK->fsys),
  2363.         LINK->LINK);
  2364.   while (P_inset(sy, P_setunion(SET2, P_expset(SET1, 1L << ((long)semicolon)),
  2365.                 statbegsys)))
  2366.   {   /*while*/
  2367.     if (sy == semicolon)
  2368.       insymbol();
  2369.     else
  2370.       error(14L);
  2371.     P_addset(P_expset(SET, 0L), (int)semicolon);
  2372.     statement(P_setunion(SET3, P_addset(SET, (int)untilsy), LINK->fsys),
  2373.           LINK->LINK);
  2374.   }
  2375.   if (sy != untilsy) {
  2376.     error(53L);
  2377.     return;
  2378.   }  /*if*/
  2379.   insymbol();
  2380.   expression(LINK->fsys, &x, LINK);
  2381.   if (((1L << ((long)x.typ)) & ((1L << ((long)bools)) | (1L << ((long)notyp)))) == 0)
  2382.     error(17L);
  2383.   emit1(11L, lc1);
  2384. }
  2385.  
  2386.  
  2387. Local Void whilestatement(LINK)
  2388. struct LOC_statement *LINK;
  2389. {
  2390.   item x;
  2391.   long lc1, lc2;
  2392.   long SET[(long)dosy / 32 + 2];
  2393.   symset SET1;
  2394.  
  2395.   /*whilestatement*/
  2396.   insymbol();
  2397.   lc1 = lc;
  2398.   expression(P_setunion(SET1, LINK->fsys,
  2399.             P_addset(P_expset(SET, 0L), (int)dosy)), &x, LINK);
  2400.   if (((1L << ((long)x.typ)) & ((1L << ((long)bools)) | (1L << ((long)notyp)))) == 0)
  2401.     error(17L);
  2402.   lc2 = lc;
  2403.   emit(11L);
  2404.   if (sy == dosy)
  2405.     insymbol();
  2406.   else
  2407.     error(54L);
  2408.   statement(LINK->fsys, LINK->LINK);
  2409.   emit1(10L, lc1);
  2410.   code[lc1].y = lc;
  2411. }
  2412.  
  2413.  
  2414. Local Void forstatement(LINK)
  2415. struct LOC_statement *LINK;
  2416. {
  2417.   types cvt;
  2418.   item x;
  2419.   long i, f, lc1, lc2;
  2420.   long SET[(long)downtosy / 32 + 2];
  2421.   symset SET1;
  2422.   long SET2[(long)dosy / 32 + 2];
  2423.  
  2424.   /*forstatement*/
  2425.   insymbol();
  2426.   if (sy == ident) {
  2427.     i = loc(id, LINK->LINK);
  2428.     insymbol();
  2429.     if (i == 0)
  2430.       cvt = ints;
  2431.     else {
  2432.       if ((object)tab[i].obj == variable) {
  2433.     cvt = (types)tab[i].typ;
  2434.     emit2(0L, (long)tab[i].lev, tab[i].adr);
  2435.     if (((1L << ((long)cvt)) & ((1L << ((long)notyp)) | (1L << ((long)ints)) |
  2436.            (1L << ((long)bools)) | (1L << ((long)chars)))) == 0)
  2437.       error(18L);
  2438.       }  /*if*/
  2439.       else {
  2440.     error(37L);
  2441.     cvt = ints;
  2442.       }  /*else*/
  2443.     }
  2444.   }  /*if*/
  2445.   else {
  2446.     P_addset(P_expset(SET, 0L), (int)becomes);
  2447.     P_addset(SET, (int)tosy);
  2448.     P_addset(SET, (int)downtosy);
  2449.     skip(P_setunion(SET1, P_addset(SET, (int)dosy), LINK->fsys), 2L,
  2450.      LINK->LINK);
  2451.   }
  2452.   if (sy == becomes) {
  2453.     insymbol();
  2454.     P_addset(P_expset(SET, 0L), (int)tosy);
  2455.     P_addset(SET, (int)downtosy);
  2456.     expression(P_setunion(SET1, P_addset(SET, (int)dosy), LINK->fsys), &x,
  2457.            LINK);
  2458.     if (x.typ != cvt)
  2459.       error(19L);
  2460.   }  /*if*/
  2461.   else {
  2462.     P_addset(P_expset(SET, 0L), (int)tosy);
  2463.     P_addset(SET, (int)downtosy);
  2464.     skip(P_setunion(SET1, P_addset(SET, (int)dosy), LINK->fsys), 51L,
  2465.      LINK->LINK);
  2466.   }
  2467.   f = 14;
  2468.   if (sy == (int)downtosy || sy == (int)tosy) {
  2469.     if (sy == downtosy)
  2470.       f = 16;
  2471.     insymbol();
  2472.     expression(P_setunion(SET1, P_addset(P_expset(SET2, 0L), (int)dosy),
  2473.               LINK->fsys), &x, LINK);
  2474.     if (x.typ != cvt)
  2475.       error(19L);
  2476.   }  /*if*/
  2477.   else
  2478.     skip(P_setunion(SET1, P_addset(P_expset(SET2, 0L), (int)dosy), LINK->fsys),
  2479.      55L, LINK->LINK);
  2480.   lc1 = lc;
  2481.   emit(f);
  2482.   if (sy == dosy)
  2483.     insymbol();
  2484.   else
  2485.     error(54L);
  2486.   lc2 = lc;
  2487.   statement(LINK->fsys, LINK->LINK);
  2488.   emit1(f + 1, lc2);
  2489.   code[lc1].y = lc;
  2490. }
  2491.  
  2492.  
  2493. Local Void standproc(n, LINK)
  2494. long n;
  2495. struct LOC_statement *LINK;
  2496. {
  2497.   long i, f;
  2498.   item x, y;
  2499.   symset SET, SET1;
  2500.  
  2501.   /*standproc*/
  2502.   switch (n) {
  2503.  
  2504.   case 1:
  2505.   case 2:   /*1*/
  2506.     /* read */
  2507.     if (!iflag) {   /*if*/
  2508.       error(20L);
  2509.       iflag = true;
  2510.     }
  2511.     if (sy == lparent) {   /*if*/
  2512.       do {
  2513.     insymbol();
  2514.     if (sy != ident)
  2515.       error(2L);
  2516.     else {   /*else*/
  2517.       i = loc(id, LINK->LINK);
  2518.       insymbol();
  2519.       if (i != 0) {
  2520.         if ((object)tab[i].obj != variable)
  2521.           error(37L);
  2522.         else {
  2523.           x.typ = (types)tab[i].typ;
  2524.           x.iref = SEXT(tab[i].iref, 18);
  2525.           if (tab[i].normal)
  2526.         f = 0;
  2527.           else
  2528.         f = 1;
  2529.           emit2(f, (long)tab[i].lev, tab[i].adr);
  2530.           if ((unsigned long)sy < 32 &&
  2531.           ((1L << ((long)sy)) & ((1L << ((long)lbrack)) |
  2532.              (1L << ((long)lparent)) | (1L << ((long)period)))) != 0)
  2533.         selector(P_setunion(SET1, LINK->fsys, P_expset(SET,
  2534.               (1L << ((long)comma)) | (1L << ((long)rparent)))), &x,
  2535.           LINK);
  2536.           if (((1L << ((long)x.typ)) &
  2537.            ((1L << ((long)ints)) | (1L << ((long)reals)) |
  2538.             (1L << ((long)chars)) | (1L << ((long)notyp)))) != 0)
  2539.         emit1(27L, (long)x.typ);
  2540.           else
  2541.         error(40L);
  2542.         }  /*else*/
  2543.       }
  2544.     }
  2545.     test(P_expset(SET, (1L << ((long)comma)) | (1L << ((long)rparent))),
  2546.          LINK->fsys, 6L, LINK->LINK);
  2547.       } while (sy == comma);
  2548.       if (sy == rparent)
  2549.     insymbol();
  2550.       else
  2551.     error(4L);
  2552.     }
  2553.     if (n == 2)
  2554.       emit(62L);
  2555.     break;
  2556.  
  2557.   case 3:
  2558.   case 4:  /*write*/
  2559.     if (sy == lparent) {   /*if*/
  2560.       do {
  2561.     insymbol();
  2562.     if (sy == string) {
  2563.       emit1(24L, sleng);
  2564.       emit1(28L, inum);
  2565.       insymbol();
  2566.     }  /*if*/
  2567.     else {
  2568.       expression(P_setunion(SET1, LINK->fsys, P_expset(SET,
  2569.              (1L << ((long)comma)) | (1L << ((long)colon)) |
  2570.              (1L << ((long)rparent)))), &x, LINK);
  2571. /* p2c: temp.p, line 2560: 
  2572.  * Note: Line breaker spent 0.0 seconds, 5000 tries on line 2570 [251] */
  2573.       if (((1L << ((long)x.typ)) & stantyps) == 0)
  2574.         error(41L);
  2575.       if (sy == colon) {
  2576.         insymbol();
  2577.         expression(P_setunion(SET1, LINK->fsys, P_expset(SET,
  2578.                (1L << ((long)comma)) | (1L << ((long)colon)) |
  2579.                (1L << ((long)rparent)))), &y, LINK);
  2580. /* p2c: temp.p, line 2560: 
  2581.  * Note: Line breaker spent 1.0 seconds, 5000 tries on line 2579 [251] */
  2582.         if (y.typ != ints)
  2583.           error(43L);
  2584.         if (sy == colon) {
  2585.           if (x.typ != reals)
  2586.         error(42L);
  2587.           insymbol();
  2588.           expression(P_setunion(SET1, LINK->fsys,
  2589.           P_expset(SET,
  2590.                (1L << ((long)comma)) | (1L << ((long)rparent)))),
  2591.         &y, LINK);
  2592.           if (y.typ != ints)
  2593.         error(43L);
  2594.           emit(37L);
  2595.         }  /*if*/
  2596.         else
  2597.           emit1(30L, (long)x.typ);
  2598.       }  /*if*/
  2599.       else
  2600.         emit1(29L, (long)x.typ);
  2601.     }  /*else*/
  2602.       } while (sy == comma);
  2603.       if (sy == rparent)
  2604.     insymbol();
  2605.       else
  2606.     error(4L);
  2607.     }
  2608.     if (n == 4)
  2609.       emit(63L);
  2610.     break;
  2611.     /*3*/
  2612.   }/*case*/
  2613. }
  2614.  
  2615.  
  2616.  
  2617.  
  2618. Local Void statement(fsys_, LINK)
  2619. long *fsys_;
  2620. struct LOC_block *LINK;
  2621. {
  2622.   struct LOC_statement V;
  2623.   long SET[(long)ident / 32 + 2];
  2624.   symset SET1;
  2625.  
  2626.  
  2627.   V.LINK = LINK;
  2628.   /*statement*/
  2629.   P_setcpy(V.fsys, fsys_);
  2630.   if (P_inset(sy, P_setunion(SET1, statbegsys,
  2631.                  P_addset(P_expset(SET, 0L), (int)ident)))) {
  2632.     switch (sy) {   /*case*/
  2633.  
  2634.     case ident:   /*ident*/
  2635.       V.i = loc(id, LINK);
  2636.       insymbol();
  2637.       if (V.i != 0) {
  2638.     switch ((object)tab[V.i].obj) {
  2639.  
  2640.     case konstant:
  2641.     case type1:
  2642.       error(45L);
  2643.       break;
  2644.  
  2645.     case variable:
  2646.       assignment((long)tab[V.i].lev, tab[V.i].adr, &V);
  2647.       break;
  2648.  
  2649.     case prozedure:
  2650.       if (tab[V.i].lev != 0)
  2651.         call(V.fsys, V.i, &V);
  2652.       else
  2653.         standproc(tab[V.i].adr, &V);
  2654.       break;
  2655.  
  2656.     case funktion:
  2657.       if (SEXT(tab[V.i].iref, 18) == display[LINK->level])
  2658.         assignment(tab[V.i].lev + 1L, 0L, &V);
  2659.       else
  2660.         error(45L);
  2661.       break;
  2662.     }/*case*/
  2663.       }
  2664.       break;
  2665.  
  2666.     case beginsy:
  2667.       compoundstatement(&V);
  2668.       break;
  2669.  
  2670.     case ifsy:
  2671.       ifstatement(&V);
  2672.       break;
  2673.  
  2674.     case casesy:
  2675.       casestatement(&V);
  2676.       break;
  2677.  
  2678.     case whilesy:
  2679.       whilestatement(&V);
  2680.       break;
  2681.  
  2682.     case repeatsy:
  2683.       repeatstatement(&V);
  2684.       break;
  2685.  
  2686.     case forsy:
  2687.       forstatement(&V);
  2688.       break;
  2689.     }
  2690.   }
  2691.   test(V.fsys, P_expset(SET1, 0L), 14L, LINK);
  2692. }
  2693.  
  2694.  
  2695. Static Void block(fsys_, isfun, level_)
  2696. long *fsys_;
  2697. boolean isfun;
  2698. long level_;
  2699. {
  2700.   struct LOC_block V;
  2701.   long prt;   /* t-index of this procedure */
  2702.   long prb;   /* b-index of this procedure */
  2703.   long x;
  2704.   symset SET, SET1;
  2705.   long SET2[(long)beginsy / 32 + 2];
  2706.   long SET3[(long)endsy / 32 + 2];
  2707.   symset SET4;
  2708.  
  2709.  
  2710.   /*block*/
  2711.   P_setcpy(V.fsys, fsys_);
  2712.   V.level = level_;
  2713.   V.dx = 5;
  2714.   prt = t;
  2715.   if (V.level > lmax)
  2716.     fatal(5L);
  2717.   test(P_expset(SET, (1L << ((long)lparent)) | (1L << ((long)colon)) |
  2718.              (1L << ((long)semicolon))), V.fsys, 7L, &V);
  2719.   enterblock();
  2720.   display[V.level] = b;
  2721.   prb = b;
  2722.   tab[prt].typ = (unsigned)notyp;
  2723.   tab[prt].iref = prb;
  2724.   if (sy == lparent)
  2725.     parameterlist(&V);
  2726.   btab[prb - 1].lastpar = t;
  2727.   btab[prb - 1].psize = V.dx;
  2728.   if (isfun) {
  2729.     if (sy == colon) {   /* function type */
  2730.       insymbol();
  2731.       if (sy == ident) {
  2732.     x = loc(id, &V);
  2733.     insymbol();
  2734.     if (x != 0) {
  2735.       if ((object)tab[x].obj != type1)
  2736.         error(29L);
  2737.       else {
  2738.         if (((1L << tab[x].typ) & stantyps) != 0)
  2739.           tab[prt].typ = (unsigned)((types)tab[x].typ);
  2740.         else
  2741.           error(15L);
  2742.       }
  2743.     }
  2744.       }  /*if*/
  2745.       else
  2746.     skip(P_setunion(SET1, P_expset(SET, 1L << ((long)semicolon)), V.fsys),
  2747.          2L, &V);
  2748.     }  /*if*/
  2749.     else
  2750.       error(5L);
  2751.   }
  2752.   if (sy == semicolon)
  2753.     insymbol();
  2754.   else
  2755.     error(14L);
  2756.   do {
  2757.     if (sy == constsy)
  2758.       constantdeclaration(&V);
  2759.     if (sy == typesy)
  2760.       typedeclaration(&V);
  2761.     if (sy == varsy)
  2762.       variabledeclaration(&V);
  2763.     btab[prb - 1].vsize = V.dx;
  2764.     while (sy == (int)functionsy || sy == (int)proceduresy)
  2765.       procdeclaration(&V);
  2766.     test(P_addset(P_expset(SET2, 0L), (int)beginsy),
  2767.      P_setunion(SET, blockbegsys, statbegsys), 56L, &V);
  2768.   } while (!P_inset(sy, statbegsys));
  2769.   tab[prt].adr = lc;
  2770.   insymbol();
  2771.   P_addset(P_expset(SET3, 0L), (int)semicolon);
  2772.   statement(P_setunion(SET, P_addset(SET3, (int)endsy), V.fsys), &V);
  2773.   while (P_inset(sy, P_setunion(SET1, P_expset(SET, 1L << ((long)semicolon)),
  2774.                 statbegsys)))
  2775.   {   /*while*/
  2776.     if (sy == semicolon)
  2777.       insymbol();
  2778.     else
  2779.       error(14L);
  2780.     P_addset(P_expset(SET3, 0L), (int)semicolon);
  2781.     statement(P_setunion(SET4, P_addset(SET3, (int)endsy), V.fsys), &V);
  2782.   }
  2783.   if (sy == endsy)
  2784.     insymbol();
  2785.   else
  2786.     error(57L);
  2787.   test(P_setunion(SET1, V.fsys, P_expset(SET, 1L << ((long)period))),
  2788.        P_expset(SET4, 0L), 6L, &V);
  2789. }
  2790.  
  2791.  
  2792. typedef union _REC_s {
  2793.   long i;
  2794.   double r;
  2795.   boolean b;
  2796.   Char c;
  2797. } _REC_s;
  2798.  
  2799.  
  2800. Static Void interpret()
  2801. {
  2802.   order ir;
  2803.   long pc;
  2804.   enum {
  2805.     run, fin, caschk, divchk, inxchk, stkchk, linchk, lngchk, redchk
  2806.   } ps;
  2807.   long t, b, lncnt, ocnt, blkcnt, chrcnt, h1, h2, h3, h4;
  2808.   long fld[4];
  2809.   long display[lmax];
  2810.   _REC_s s[stacksize];
  2811.   long TEMP;
  2812.   double TEMP1;
  2813.   _REC_tab *WITH;
  2814.  
  2815.   /*interpret*/
  2816.   s[0].i = 0;
  2817.   s[1].i = 0;
  2818.   s[2].i = -1;
  2819.   s[3].i = btab[0].last;
  2820.   b = 0;
  2821.   display[0] = 0;
  2822.   t = btab[1].vsize - 1;
  2823.   pc = tab[s[3].i].adr;
  2824.   ps = run;
  2825.   lncnt = 0;
  2826.   ocnt = 0;
  2827.   chrcnt = 0;
  2828.   fld[0] = 10;
  2829.   fld[1] = 22;
  2830.   fld[2] = 10;
  2831.   fld[3] = 1;
  2832.   do {
  2833.     ir = code[pc];
  2834.     pc++;
  2835.     ocnt++;
  2836.     switch (ir.f) {   /* case */
  2837.  
  2838.     case 0:   /*0*/
  2839.       /* load address */
  2840.       t++;
  2841.       if (t > stacksize)
  2842.     ps = stkchk;
  2843.       else
  2844.     s[t - 1].i = display[ir.x - 1] + ir.y;
  2845.       break;
  2846.  
  2847.     case 1:   /*1*/
  2848.       /* load value */
  2849.       t++;
  2850.       if (t > stacksize)
  2851.     ps = stkchk;
  2852.       else
  2853.     s[t - 1] = s[display[ir.x - 1] + ir.y - 1];
  2854.       break;
  2855.  
  2856.     case 2:   /*2*/
  2857.       /* load indirect */
  2858.       t++;
  2859.       if (t > stacksize)
  2860.     ps = stkchk;
  2861.       else
  2862.     s[t - 1] = s[s[display[ir.x - 1] + ir.y - 1].i - 1];
  2863.       break;
  2864.  
  2865.     case 3:   /*3*/
  2866.       /* update display */
  2867.       h1 = ir.y;
  2868.       h2 = ir.x;
  2869.       h3 = b;
  2870.       do {
  2871.     display[h1 - 1] = h3;
  2872.     h1--;
  2873.     h3 = s[h3 + 1].i;
  2874.       } while (h1 != h2);
  2875.       break;
  2876.  
  2877.     case 8:
  2878.       switch (ir.y) {   /*case*/
  2879.  
  2880.       case 0:
  2881.     s[t - 1].i = labs(s[t - 1].i);
  2882.     break;
  2883.  
  2884.       case 1:
  2885.     s[t - 1].r = fabs(s[t - 1].r);
  2886.     break;
  2887.  
  2888.       case 2:
  2889.     TEMP = s[t - 1].i;
  2890.     s[t - 1].i = TEMP * TEMP;
  2891.     break;
  2892.  
  2893.       case 3:
  2894.     TEMP1 = s[t - 1].r;
  2895.     s[t - 1].r = TEMP1 * TEMP1;
  2896.     break;
  2897.  
  2898.       case 4:
  2899.     s[t - 1].b = s[t - 1].i & 1;
  2900.     break;
  2901.  
  2902.       case 5:   /*5*/
  2903.     /* s[t].c := chr(s[t].i); */
  2904.     if ((unsigned long)s[t - 1].i > 63)
  2905.       ps = inxchk;
  2906.     break;
  2907.  
  2908.       case 6:   /* s[t].i:=ord(s[t].c) */
  2909.     break;
  2910.  
  2911.       case 7:
  2912.     s[t - 1].c++;
  2913.     break;
  2914.  
  2915.       case 8:
  2916.     s[t - 1].c--;
  2917.     break;
  2918.  
  2919.       case 9:
  2920.     s[t - 1].i = (long)floor(s[t - 1].r + 0.5);
  2921.     break;
  2922.  
  2923.       case 10:
  2924.     s[t - 1].i = (long)s[t - 1].r;
  2925.     break;
  2926.  
  2927.       case 11:
  2928.     s[t - 1].r = sin(s[t - 1].r);
  2929.     break;
  2930.  
  2931.       case 12:
  2932.     s[t - 1].r = cos(s[t - 1].r);
  2933.     break;
  2934.  
  2935.       case 13:
  2936.     s[t - 1].r = exp(s[t - 1].r);
  2937.     break;
  2938.  
  2939.       case 14:
  2940.     s[t - 1].r = log(s[t - 1].r);
  2941.     break;
  2942.  
  2943.       case 15:
  2944.     s[t - 1].r = sqrt(s[t - 1].r);
  2945.     break;
  2946.  
  2947.       case 16:
  2948.     s[t - 1].r = atan(s[t - 1].r);
  2949.     break;
  2950.  
  2951.       case 17:   /*17*/
  2952.     t++;
  2953.     if (t > stacksize)
  2954.       ps = stkchk;
  2955.     else
  2956.       s[t - 1].b = P_eof(stdin);
  2957.     break;
  2958.  
  2959.       case 18:   /*18*/
  2960.     t++;
  2961.     if (t > stacksize)
  2962.       ps = stkchk;
  2963.     else
  2964.       s[t - 1].b = P_eoln(stdin);
  2965.     break;
  2966.       }
  2967.       break;
  2968.  
  2969.     case 9:
  2970.       s[t - 1].i += ir.y;   /* offset */
  2971.       break;
  2972.  
  2973.     case 10:
  2974.       pc = ir.y;   /* jump */
  2975.       break;
  2976.  
  2977.     case 11:   /*11*/
  2978.       /* conditional jump */
  2979.       if (!s[t - 1].b)
  2980.     pc = ir.y;
  2981.       t--;
  2982.       break;
  2983.  
  2984.     case 12:   /*12*/
  2985.       /* switch */
  2986.       h1 = s[t - 1].i;
  2987.       t--;
  2988.       h2 = ir.y;
  2989.       h3 = 0;
  2990.       do {
  2991.     if (code[h2].f != 13) {
  2992.       h3 = 1;
  2993.       ps = caschk;
  2994.     }  /*if*/
  2995.     else {
  2996.       if (code[h2].y == h1) {
  2997.         h3 = 1;
  2998.         pc = code[h2 + 1].y;
  2999.       }  /*if*/
  3000.       else
  3001.         h2 += 2;
  3002.     }
  3003.       } while (h3 == 0);
  3004.       break;
  3005.  
  3006.     case 14:   /*14*/
  3007.       /* for1up*/
  3008.       h1 = s[t - 2].i;
  3009.       if (h1 <= s[t - 1].i)
  3010.     s[s[t - 3].i - 1].i = h1;
  3011.       else {
  3012.     t -= 3;
  3013.     pc = ir.y;
  3014.       }  /*else*/
  3015.       break;
  3016.  
  3017.     case 15:   /*15*/
  3018.       /* for2up */
  3019.       h2 = s[t - 3].i;
  3020.       h1 = s[h2 - 1].i + 1;
  3021.       if (h1 <= s[t - 1].i) {
  3022.     s[h2 - 1].i = h1;
  3023.     pc = ir.y;
  3024.       }  /*if*/
  3025.       else
  3026.     t -= 3;
  3027.       break;
  3028.  
  3029.     case 16:   /*16*/
  3030.       /*for1down*/
  3031.       h1 = s[t - 2].i;
  3032.       if (h1 >= s[t - 1].i)
  3033.     s[s[t - 3].i - 1].i = h1;
  3034.       else {
  3035.     pc = ir.y;
  3036.     t -= 3;
  3037.       }  /*else*/
  3038.       break;
  3039.  
  3040.     case 17:   /*17*/
  3041.       /*for2down*/
  3042.       h2 = s[t - 3].i;
  3043.       h1 = s[h2 - 1].i - 1;
  3044.       if (h1 >= s[t - 1].i) {
  3045.     s[h2 - 1].i = h1;
  3046.     pc = ir.y;
  3047.       }  /*if*/
  3048.       else
  3049.     t -= 3;
  3050.       break;
  3051.  
  3052.     case 18:   /*18*/
  3053.       /* marck stack*/
  3054.       h1 = btab[SEXT(tab[ir.y].iref, 18) - 1].vsize;
  3055.       if (t + h1 > stacksize)
  3056.     ps = stkchk;
  3057.       else {
  3058.     t += 5;
  3059.     s[t - 2].i = h1 - 1;
  3060.     s[t - 1].i = ir.y;
  3061.       }  /*else*/
  3062.       break;
  3063.  
  3064.     case 19:   /*19*/
  3065.       /* call */
  3066.       h1 = t - ir.y;   /*h1 points to base */
  3067.       h2 = s[h1 + 3].i;   /*h2 points to tab */
  3068.       h3 = tab[h2].lev;
  3069.       display[h3] = h1;
  3070.       h4 = s[h1 + 2].i + h1;
  3071.       s[h1].i = pc;
  3072.       s[h1 + 1].i = display[h3 - 1];
  3073.       s[h1 + 2].i = b;
  3074.       for (h3 = t; h3 < h4; h3++)
  3075.     s[h3].i = 0;
  3076.       b = h1;
  3077.       t = h4;
  3078.       pc = tab[h2].adr;
  3079.       break;
  3080.  
  3081.     case 20:   /*20*/
  3082.       /* index1 */
  3083.       h1 = ir.y;   /* h1 points to atab */
  3084.       h2 = SEXT(atab[h1 - 1].low, 18);
  3085.       h3 = s[t - 1].i;
  3086.       if (h3 < h2)
  3087.     ps = inxchk;
  3088.       else {
  3089.     if (h3 > SEXT(atab[h1 - 1].high, 18))
  3090.       ps = inxchk;
  3091.     else {
  3092.       t--;
  3093.       s[t - 1].i += h3 - h2;
  3094.     }  /*else*/
  3095.       }
  3096.       break;
  3097.  
  3098.     case 21:   /*21*/
  3099.       /* index */
  3100.       h1 = ir.y;   /* h1 points to atab */
  3101.       h2 = SEXT(atab[h1 - 1].low, 18);
  3102.       h3 = s[t - 1].i;
  3103.       if (h3 < h2)
  3104.     ps = inxchk;
  3105.       else {
  3106.     if (h3 > SEXT(atab[h1 - 1].high, 18))
  3107.       ps = inxchk;
  3108.     else {
  3109.       t--;
  3110.       s[t - 1].i += (h3 - h2) * SEXT(atab[h1 - 1].elsize, 18);
  3111.     }  /*else*/
  3112.       }
  3113.       break;
  3114.  
  3115.     case 22:   /*22*/
  3116.       /* load block */
  3117.       h1 = s[t - 1].i;
  3118.       t--;
  3119.       h2 = ir.y + t;
  3120.       if (h2 > stacksize)
  3121.     ps = stkchk;
  3122.       else {
  3123.     while (t < h2) {
  3124.       t++;
  3125.       s[t - 1] = s[h1 - 1];
  3126.       h1++;
  3127.     }  /*while*/
  3128.       }
  3129.       break;
  3130.  
  3131.     case 23:   /*23*/
  3132.       /* copy block */
  3133.       h1 = s[t - 2].i;
  3134.       h2 = s[t - 1].i;
  3135.       h3 = h1 + ir.y;
  3136.       while (h1 < h3) {   /*while*/
  3137.     s[h1 - 1] = s[h2 - 1];
  3138.     h1++;
  3139.     h2++;
  3140.       }
  3141.       t -= 2;
  3142.       break;
  3143.  
  3144.     case 24:   /*24*/
  3145.       /* literal */
  3146.       t--;
  3147.       if (t > stacksize)
  3148.     ps = stkchk;
  3149.       else
  3150.     s[t - 1].i = ir.y;
  3151.       break;
  3152.  
  3153.     case 25:   /*25*/
  3154.       /* load real */
  3155.       t--;
  3156.       if (t > stacksize)
  3157.     ps = stkchk;
  3158.       else
  3159.     s[t - 1].r = rconst[ir.y - 1];
  3160.       break;
  3161.  
  3162.     case 26:   /*26*/
  3163.       /* float */
  3164.       h1 = t - ir.y;
  3165.       s[h1 - 1].r = s[h1 - 1].i;
  3166.       break;
  3167.  
  3168.     case 27:   /*27*/
  3169.       /* read */
  3170.       if (P_eof(stdin))
  3171.     ps = redchk;
  3172.       else {
  3173.     switch (ir.y) {   /*case*/
  3174.  
  3175.     case 1:
  3176.       scanf("%ld", &s[s[t - 1].i - 1].i);
  3177.       break;
  3178.  
  3179.     case 2:
  3180.       scanf("%lg", &s[s[t - 1].i - 1].r);
  3181.       break;
  3182.  
  3183.     case 3:
  3184.       s[s[t - 1].i - 1].c = getchar();
  3185.       if (s[s[t - 1].i - 1].c == '\n')
  3186.         s[s[t - 1].i - 1].c = ' ';
  3187.       break;
  3188.     }
  3189.       }
  3190.       t--;
  3191.       break;
  3192.  
  3193.     case 28:   /*28*/
  3194.       /* write string */
  3195.       h1 = s[t - 1].i;
  3196.       h2 = ir.y;
  3197.       t--;
  3198.       chrcnt += h1;
  3199.       if (chrcnt > lineleng)
  3200.     ps = lngchk;
  3201.       do {
  3202.     putchar(stab[h2]);
  3203.     h1--;
  3204.     h2++;
  3205.       } while (h1 != 0);
  3206.       break;
  3207.  
  3208.     case 29:   /*29*/
  3209.       /* write1 */
  3210.       chrcnt += fld[ir.y - 1];
  3211.       if (chrcnt > lineleng)
  3212.     ps = lngchk;
  3213.       else {
  3214.     switch (ir.y) {   /*case*/
  3215.  
  3216.     case 1:
  3217.       printf("%*ld", (int)fld[0], s[t - 1].i);
  3218.       break;
  3219.  
  3220.     case 2:
  3221.       printf("% .*E", P_max((int)fld[1] - 7, 1), s[t - 1].r);
  3222.       break;
  3223.  
  3224.     case 3:
  3225.       printf("%*s", (int)fld[2], s[t - 1].b ? "TRUE" : "FALSE");
  3226.       break;
  3227.  
  3228.     case 4:
  3229.       putchar(s[t - 1].c);
  3230.       break;
  3231.     }
  3232.       }
  3233.       t--;
  3234.       break;
  3235.  
  3236.     case 30:   /*30*/
  3237.       /* write2 */
  3238.       chrcnt += s[t - 1].i;
  3239.       if (chrcnt > lineleng)
  3240.     ps = lngchk;
  3241.       else {
  3242.     switch (ir.y) {   /*case*/
  3243.  
  3244.     case 1:
  3245.       printf("%*ld", (int)s[t - 1].i, s[t - 2].i);
  3246.       break;
  3247.  
  3248.     case 2:
  3249.       printf("% .*E", P_max((int)s[t - 1].i - 7, 1), s[t - 2].r);
  3250.       break;
  3251.  
  3252.     case 3:
  3253.       printf("%*s", (int)s[t - 1].i, s[t - 2].b ? "TRUE" : "FALSE");
  3254.       break;
  3255.  
  3256.     case 4:
  3257.       printf("%*c", (int)s[t - 1].i, s[t - 2].c);
  3258.       break;
  3259.     }
  3260.       }
  3261.       t -= 2;
  3262.       break;
  3263.  
  3264.     case 31:
  3265.       ps = fin;
  3266.       break;
  3267.  
  3268.     case 32:   /*32*/
  3269.       /* exit procedure */
  3270.       t = b - 1;
  3271.       pc = s[b].i;
  3272.       b = s[b + 2].i;
  3273.       break;
  3274.  
  3275.     case 33:   /*33*/
  3276.       /* exit function */
  3277.       t = b;
  3278.       pc = s[b].i;
  3279.       b = s[b + 2].i;
  3280.       break;
  3281.  
  3282.     case 34:
  3283.       s[t - 1] = s[s[t - 1].i - 1];
  3284.       break;
  3285.  
  3286.     case 35:
  3287.       s[t - 1].b = !s[t - 1].b;
  3288.       break;
  3289.  
  3290.     case 36:
  3291.       s[t - 1].i = -s[t - 1].i;
  3292.       break;
  3293.  
  3294.     case 37:   /*37*/
  3295.       chrcnt += s[t - 2].i;
  3296.       if (chrcnt > lineleng)
  3297.     ps = lngchk;
  3298.       else
  3299.     printf("%*.*f", (int)s[t - 2].i, (int)s[t - 1].i, s[t - 3].r);
  3300.       t -= 3;
  3301.       break;
  3302.  
  3303.     case 38:   /*38*/
  3304.       /* store */
  3305.       s[s[t - 2].i - 1] = s[t - 1];
  3306.       t -= 2;
  3307.       break;
  3308.  
  3309.     case 39:   /*39*/
  3310.       t--;
  3311.       s[t - 1].b = (s[t - 1].r == s[t].r);
  3312.       break;
  3313.  
  3314.     case 40:   /*40*/
  3315.       t--;
  3316.       s[t - 1].b = (s[t - 1].r != s[t].r);
  3317.       break;
  3318.  
  3319.     case 41:   /*41*/
  3320.       t--;
  3321.       s[t - 1].b = (s[t - 1].r < s[t].r);
  3322.       break;
  3323.  
  3324.     case 42:   /*42*/
  3325.       t--;
  3326.       s[t - 1].b = (s[t - 1].r <= s[t].r);
  3327.       break;
  3328.  
  3329.     case 43:   /*43*/
  3330.       t--;
  3331.       s[t - 1].b = (s[t - 1].r > s[t].r);
  3332.       break;
  3333.  
  3334.     case 44:   /*44*/
  3335.       t--;
  3336.       s[t - 1].b = (s[t - 1].r >= s[t].r);
  3337.       break;
  3338.  
  3339.     case 45:   /*45*/
  3340.       t--;
  3341.       s[t - 1].b = (s[t - 1].i == s[t].i);
  3342.       break;
  3343.  
  3344.     case 46:   /*46*/
  3345.       t--;
  3346.       s[t - 1].b = (s[t - 1].i != s[t].i);
  3347.       break;
  3348.  
  3349.     case 47:   /*47*/
  3350.       t--;
  3351.       s[t - 1].b = (s[t - 1].i < s[t].i);
  3352.       break;
  3353.  
  3354.     case 48:   /*48*/
  3355.       t--;
  3356.       s[t - 1].b = (s[t - 1].i <= s[t].i);
  3357.       break;
  3358.  
  3359.     case 49:   /*49*/
  3360.       t--;
  3361.       s[t - 1].b = (s[t - 1].i > s[t].i);
  3362.       break;
  3363.  
  3364.     case 50:   /*50*/
  3365.       t--;
  3366.       s[t - 1].b = (s[t - 1].i >= s[t].i);
  3367.       break;
  3368.  
  3369.     case 51:   /*51*/
  3370.       t--;
  3371.       s[t - 1].b = (s[t - 1].b || s[t].b);
  3372.       break;
  3373.  
  3374.     case 52:   /*52*/
  3375.       t--;
  3376.       s[t - 1].i += s[t].i;
  3377.       break;
  3378.  
  3379.     case 53:   /*53*/
  3380.       t--;
  3381.       s[t - 1].i -= s[t].i;
  3382.       break;
  3383.  
  3384.     case 54:   /*54*/
  3385.       t--;
  3386.       s[t - 1].r += s[t].r;
  3387.       break;
  3388.  
  3389.     case 55:   /*55*/
  3390.       t--;
  3391.       s[t - 1].r -= s[t].r;
  3392.       break;
  3393.  
  3394.     case 56:   /*56*/
  3395.       t--;
  3396.       s[t - 1].b = (s[t - 1].b && s[t].b);
  3397.       break;
  3398.  
  3399.     case 57:   /*57*/
  3400.       t--;
  3401.       s[t - 1].i *= s[t].i;
  3402.       break;
  3403.  
  3404.     case 58:   /*58*/
  3405.       t--;
  3406.       if (s[t].i == 0)
  3407.     ps = divchk;
  3408.       else
  3409.     s[t - 1].i /= s[t].i;
  3410.       break;
  3411.  
  3412.     case 59:   /*59*/
  3413.       t--;
  3414.       if (s[t].i == 0)
  3415.     ps = divchk;
  3416.       else {
  3417.     s[t - 1].i %= s[t].i;
  3418. /* p2c: temp.p, line 3116:
  3419.  * Note: Using % for possibly-negative arguments [317] */
  3420.       }
  3421.       break;
  3422.  
  3423.     case 60:   /*60*/
  3424.       t--;
  3425.       s[t - 1].r *= s[t].r;
  3426.       break;
  3427.  
  3428.     case 61:   /*61*/
  3429.       t--;
  3430.       s[t - 1].r /= s[t].r;
  3431.       break;
  3432.  
  3433.     case 62:
  3434.       if (P_eof(stdin))
  3435.     ps = redchk;
  3436.       else {
  3437.     scanf("%*[^\n]");
  3438.     getchar();
  3439.       }
  3440.       break;
  3441.  
  3442.     case 63:
  3443.       putchar('\n');
  3444.       lncnt++;
  3445.       chrcnt = 0;
  3446.       if (lncnt > linelimit)
  3447.     ps = linchk;
  3448.       break;
  3449.       /*63*/
  3450.     }
  3451.   } while (ps == run);
  3452.   if (ps != fin) {   /*if*/
  3453.     printf("\n0halt at %5ld because of ", pc);
  3454.     switch (ps) {   /*case*/
  3455.  
  3456.     case caschk:
  3457.       printf("undefined case\n");
  3458.       break;
  3459.  
  3460.     case divchk:
  3461.       printf("division by 0\n");
  3462.       break;
  3463.  
  3464.     case inxchk:
  3465.       printf("storage overflow\n");
  3466.       break;
  3467.  
  3468.     case linchk:
  3469.       printf("too much output\n");
  3470.       break;
  3471.  
  3472.     case lngchk:
  3473.       printf("line too long\n");
  3474.       break;
  3475.  
  3476.     case redchk:
  3477.       printf("reading past end of file\n");
  3478.       break;
  3479.     }
  3480.     h1 = b;
  3481.     blkcnt = 10;   /* post mortem dump */
  3482.     do {
  3483.       putchar('\n');
  3484.       blkcnt--;
  3485.       if (blkcnt == 0)
  3486.     h1 = 0;
  3487.       h2 = s[h1 + 3].i;
  3488.       if (h1 != 0)
  3489.     printf(" %.*s  called at%5ld\n", alphalength, tab[h2].name, s[h1].i);
  3490.       h2 = btab[SEXT(tab[h2].iref, 18) - 1].last;
  3491.       while (h2 != 0) {
  3492.     WITH = &tab[h2];
  3493.     if ((object)WITH->obj == variable) {
  3494.       if (((1L << WITH->typ) & stantyps) != 0) {   /*if*/
  3495.         printf("    %.*s = ", alphalength, WITH->name);
  3496.         if (WITH->normal)
  3497.           h3 = h1 + WITH->adr;
  3498.         else
  3499.           h3 = s[h1 + WITH->adr - 1].i;
  3500.         switch ((types)WITH->typ) {
  3501.  
  3502.         case ints:
  3503.           printf("%12ld\n", s[h3 - 1].i);
  3504.           break;
  3505.  
  3506.         case reals:
  3507.           printf("% .5E\n", s[h3 - 1].r);
  3508.           break;
  3509.  
  3510.         case bools:
  3511.           puts(s[h3 - 1].b ? " TRUE" : "FALSE");
  3512.           break;
  3513.  
  3514.         case chars:
  3515.           printf("%c\n", s[h3 - 1].c);
  3516.           break;
  3517.         }/*case*/
  3518.       }
  3519.     }
  3520.     h2 = WITH->link;   /*with*/
  3521.       }
  3522.       h1 = s[h1 + 2].i;
  3523.     } while (h1 >= 0);
  3524.   }
  3525.   printf("\n%12ld steps\n", ocnt);
  3526. }
  3527.  
  3528.  
  3529. main(argc, argv)
  3530. int argc;
  3531. Char *argv[];
  3532. {  /* main program */
  3533.   symset SET;
  3534.   _REC_btab *WITH;
  3535.  
  3536.   PASCAL_MAIN(argc, argv);
  3537.   /*pascals*/
  3538.   if (setjmp(_JL99))
  3539.     goto _L99;
  3540.   putchar('\n');
  3541.   memcpy(key[0], "and       ", sizeof(alfa_));
  3542.   memcpy(key[1], "array     ", sizeof(alfa_));
  3543.   memcpy(key[2], "begin     ", sizeof(alfa_));
  3544.   memcpy(key[3], "case      ", sizeof(alfa_));
  3545.   memcpy(key[4], "const     ", sizeof(alfa_));
  3546.   memcpy(key[5], "div       ", sizeof(alfa_));
  3547.   memcpy(key[6], "downto    ", sizeof(alfa_));
  3548.   memcpy(key[7], "do        ", sizeof(alfa_));
  3549.   memcpy(key[8], "else      ", sizeof(alfa_));
  3550.   memcpy(key[9], "end       ", sizeof(alfa_));
  3551.   memcpy(key[10], "for       ", sizeof(alfa_));
  3552.   memcpy(key[11], "function  ", sizeof(alfa_));
  3553.   memcpy(key[12], "if        ", sizeof(alfa_));
  3554.   memcpy(key[13], "mod       ", sizeof(alfa_));
  3555.   memcpy(key[14], "not       ", sizeof(alfa_));
  3556.   memcpy(key[15], "of        ", sizeof(alfa_));
  3557.   memcpy(key[16], "or        ", sizeof(alfa_));
  3558.   memcpy(key[17], "procedure ", sizeof(alfa_));
  3559.   memcpy(key[18], "program   ", sizeof(alfa_));
  3560.   memcpy(key[19], "record    ", sizeof(alfa_));
  3561.   memcpy(key[20], "repeat    ", sizeof(alfa_));
  3562.   memcpy(key[21], "then      ", sizeof(alfa_));
  3563.   memcpy(key[22], "to        ", sizeof(alfa_));
  3564.   memcpy(key[23], "type      ", sizeof(alfa_));
  3565.   memcpy(key[24], "until     ", sizeof(alfa_));
  3566.   memcpy(key[25], "var       ", sizeof(alfa_));
  3567.   memcpy(key[26], "while     ", sizeof(alfa_));
  3568.   ksy[0] = andsy;
  3569.   ksy[1] = arraysy;
  3570.   ksy[2] = beginsy;
  3571.   ksy[3] = casesy;
  3572.   ksy[4] = constsy;
  3573.   ksy[5] = idiv;
  3574.   ksy[6] = downtosy;
  3575.   ksy[7] = dosy;
  3576.   ksy[8] = elsesy;
  3577.   ksy[9] = endsy;
  3578.   ksy[10] = forsy;
  3579.   ksy[11] = functionsy;
  3580.   ksy[12] = ifsy;
  3581.   ksy[13] = imod;
  3582.   ksy[14] = notsy;
  3583.   ksy[15] = ofsy;
  3584.   ksy[16] = orsy;
  3585.   ksy[17] = proceduresy;
  3586.   ksy[18] = programsy;
  3587.   ksy[19] = recordsy;
  3588.   ksy[20] = repeatsy;
  3589.   ksy[21] = thensy;
  3590.   ksy[22] = tosy;
  3591.   ksy[23] = typesy;
  3592.   ksy[24] = untilsy;
  3593.   ksy[25] = varsy;
  3594.   ksy[26] = whilesy;
  3595.   sps['+'] = plus;
  3596.   sps['-'] = minus;
  3597.   sps['*'] = times;
  3598.   sps['/'] = rdiv;
  3599.   sps['='] = eql;
  3600.   sps['['] = lbrack;
  3601.   sps[']'] = rbrack;
  3602.   sps['&'] = andsy;
  3603.   sps['('] = lparent;
  3604.   sps[')'] = rparent;
  3605.   sps[','] = comma;
  3606.   sps['#'] = neq;
  3607.   sps[';'] = semicolon;
  3608.   P_addset(P_expset(constbegsys, 0L), (int)plus);
  3609.   P_addset(constbegsys, (int)minus);
  3610.   P_addset(constbegsys, (int)intcon);
  3611.   P_addset(constbegsys, (int)realcon);
  3612.   P_addset(constbegsys, (int)charcon);
  3613.   P_addset(constbegsys, (int)ident);
  3614.   P_addset(P_expset(typebegsys, 0L), (int)ident);
  3615.   P_addset(typebegsys, (int)arraysy);
  3616.   P_addset(typebegsys, (int)recordsy);
  3617.   P_addset(P_expset(blockbegsys, 0L), (int)constsy);
  3618.   P_addset(blockbegsys, (int)typesy);
  3619.   P_addset(blockbegsys, (int)varsy);
  3620.   P_addset(blockbegsys, (int)proceduresy);
  3621.   P_addset(blockbegsys, (int)functionsy);
  3622.   P_addset(blockbegsys, (int)beginsy);
  3623.   P_addset(P_expset(facbegsys, 0L), (int)intcon);
  3624.   P_addset(facbegsys, (int)realcon);
  3625.   P_addset(facbegsys, (int)charcon);
  3626.   P_addset(facbegsys, (int)ident);
  3627.   P_addset(facbegsys, (int)lparent);
  3628.   P_addset(facbegsys, (int)notsy);
  3629.   P_addset(P_expset(statbegsys, 0L), (int)beginsy);
  3630.   P_addset(statbegsys, (int)ifsy);
  3631.   P_addset(statbegsys, (int)whilesy);
  3632.   P_addset(statbegsys, (int)repeatsy);
  3633.   P_addset(statbegsys, (int)forsy);
  3634.   P_addset(statbegsys, (int)casesy);
  3635.   stantyps = (1L << ((long)notyp)) | (1L << ((long)ints)) |
  3636.       (1L << ((long)reals)) | (1L << ((long)bools)) | (1L << ((long)chars));
  3637.   lc = 0;
  3638.   ll = 0;
  3639.   cc = 0;
  3640.   ch = ' ';
  3641.   errpos = 0;
  3642.   P_expset(errs, 0L);
  3643.   insymbol();
  3644.   t = -1;
  3645.   a = 0;
  3646.   b = 1;
  3647.   sx = 0;
  3648.   c2 = 0;
  3649.   display[0] = 1;
  3650.   iflag = false;
  3651.   oflag = false;
  3652.   if (sy != programsy)
  3653.     error(3L);
  3654.   else {   /*else*/
  3655.     insymbol();
  3656.     if (sy != ident)
  3657.       error(2L);
  3658.     else {
  3659.       memcpy(progname, id, sizeof(alfa_));
  3660.       insymbol();
  3661.       if (sy != lparent)
  3662.     error(9L);
  3663.       else {
  3664.     do {
  3665.       insymbol();
  3666.       if (sy != ident)
  3667.         error(2L);
  3668.       else {
  3669.         if (!strncmp(id, "input     ", sizeof(alfa_)))
  3670.           iflag = true;
  3671.         else {
  3672.           if (!strncmp(id, "output    ", sizeof(alfa_)))
  3673.         oflag = true;
  3674.           else
  3675.         error(0L);
  3676.         }
  3677.         insymbol();
  3678.       }  /*else*/
  3679.     } while (sy == comma);
  3680.       }
  3681.       if (sy == rparent)
  3682.     insymbol();
  3683.       else
  3684.     error(4L);
  3685.       if (!oflag)
  3686.     error(20L);
  3687.     }  /*else*/
  3688.   }
  3689.   enter("          ", variable, notyp, 0L);
  3690.   enter("false     ", konstant, bools, 0L);
  3691.   enter("true      ", konstant, bools, 1L);
  3692.   enter("real      ", type1, reals, 1L);
  3693.   enter("char      ", type1, chars, 1L);
  3694.   enter("boolean   ", type1, bools, 1L);
  3695.   enter("integer   ", type1, ints, 1L);
  3696.   enter("abs       ", funktion, reals, 0L);
  3697.   enter("sqr       ", funktion, reals, 2L);
  3698.   enter("odd       ", funktion, bools, 4L);
  3699.   enter("chr       ", funktion, chars, 5L);
  3700.   enter("ord       ", funktion, ints, 6L);
  3701.   enter("succ      ", funktion, chars, 7L);
  3702.   enter("pred      ", funktion, chars, 8L);
  3703.   enter("round     ", funktion, ints, 9L);
  3704.   enter("trunc     ", funktion, ints, 10L);
  3705.   enter("sin       ", funktion, reals, 11L);
  3706.   enter("cos       ", funktion, reals, 12L);
  3707.   enter("exp       ", funktion, reals, 13L);
  3708.   enter("ln        ", funktion, reals, 14L);
  3709.   enter("sqrt      ", funktion, reals, 15L);
  3710.   enter("arctan    ", funktion, reals, 16L);
  3711.   enter("eof       ", funktion, bools, 17L);
  3712.   enter("eoln      ", funktion, bools, 18L);
  3713.   enter("read      ", prozedure, notyp, 1L);
  3714.   enter("readln    ", prozedure, notyp, 2L);
  3715.   enter("write     ", prozedure, notyp, 3L);
  3716.   enter("writeln   ", prozedure, notyp, 4L);
  3717.   enter("          ", prozedure, notyp, 0L);
  3718.   WITH = btab;
  3719.   WITH->last = t;
  3720.   WITH->lastpar = 1;
  3721.   WITH->psize = 0;
  3722.   WITH->vsize = 0;   /*with*/
  3723.   block(P_setunion(SET, blockbegsys, statbegsys), false, 1L);
  3724.   if (sy != period)   /* halt */
  3725.     error(22L);
  3726.   emit(31L);
  3727.   if (btab[1].vsize > stacksize)
  3728.     error(49L);
  3729.   if (!strncmp(progname, "test0     ", sizeof(alfa_)))
  3730.     printtables();
  3731.   if (*errs == 0L) {
  3732.     if (iflag) {   /*if*/
  3733.       if (P_eof(stdin))
  3734.     printf(" input data missing\n");
  3735.       else {
  3736.     printf(" (eor) \n");   /* copy input data */
  3737.     while (!P_eof(stdin)) {   /*while*/
  3738.       putchar(' ');
  3739.       while (!P_eoln(stdin)) {   /*while*/
  3740.         ch = getchar();
  3741.         if (ch == '\n')
  3742.           ch = ' ';
  3743.         putchar(ch);
  3744.       }
  3745.       putchar('\n');
  3746.       ch = getchar();
  3747.       if (ch == '\n')
  3748.         ch = ' ';
  3749.     }
  3750.       }  /*else*/
  3751.     }
  3752.     printf(" (eof) \n");
  3753.     interpret();
  3754.   }  /*if*/
  3755.   else
  3756.     errormsg();
  3757. _L99:
  3758.   exit(EXIT_SUCCESS);
  3759. }
  3760.  
  3761.  
  3762.  
  3763. /* End. */
  3764.